/[cmucl]/src/hemlock/lispmode.lisp
ViewVC logotype

Contents of /src/hemlock/lispmode.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.16 - (hide annotations) (vendor branch)
Sat Feb 15 01:01:50 1992 UTC (22 years, 2 months ago) by wlott
Changes since 1.1.1.15: +1 -2 lines
Removed declaration for non-existant variables.
1 ram 1.1 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.1.1.4 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7     ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8     ;;;
9     (ext:file-comment
10 wlott 1.1.1.16 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/lispmode.lisp,v 1.1.1.16 1992/02/15 01:01:50 wlott Exp $")
11 ram 1.1.1.4 ;;;
12 ram 1.1 ;;; **********************************************************************
13     ;;;
14     ;;; Hemlock LISP Mode commands
15     ;;;
16     ;;; Written by Ivan Vazquez and Bill Maddox.
17     ;;;
18    
19     (in-package "HEMLOCK")
20    
21    
22    
23 chiles 1.1.1.5 ;;;; Variables and lisp-info structure.
24    
25 ram 1.1 ;;; These routines are used to define, for standard LISP mode, the start and end
26     ;;; of a block to parse. If these need to be changed for a minor mode that sits
27     ;;; on top of LISP mode, simply do a DEFHVAR with the minor mode and give the
28     ;;; name of the function to use instead of START-OF-PARSE-BLOCK and
29     ;;; END-OF-PARSE-BLOCK.
30     ;;;
31    
32     (defhvar "Parse Start Function"
33     "Take a mark and move it to the top of a block for paren parsing."
34     :value 'start-of-parse-block)
35    
36     (defhvar "Parse End Function"
37     "Take a mark and move it to the bottom of a block for paren parsing."
38     :value 'end-of-parse-block)
39    
40    
41 chiles 1.1.1.5 ;;; LISP-INFO is the structure used to store the data about the line in its
42     ;;; Plist.
43     ;;;
44 ram 1.1 ;;; -> BEGINS-QUOTED, ENDING-QUOTED are both Boolean slots that tell whether
45     ;;; or not a line's begining and/or ending are quoted.
46     ;;;
47     ;;; -> RANGES-TO-IGNORE is a list of cons cells, each having the form
48     ;;; ( [begining-charpos] [end-charpos] ) each of these cells indicating
49     ;;; a range to ignore. End is exclusive.
50     ;;;
51     ;;; -> NET-OPEN-PARENS, NET-CLOSE-PARENS integers that are the number of
52     ;;; unmatched opening and closing parens that there are on a line.
53     ;;;
54     ;;; -> SIGNATURE-SLOT ...
55     ;;;
56    
57     (defstruct (lisp-info (:constructor make-lisp-info ()))
58     (begins-quoted nil) ; (or t nil)
59     (ending-quoted nil) ; (or t nil)
60     (ranges-to-ignore nil) ; (or t nil)
61     (net-open-parens 0 :type fixnum)
62     (net-close-parens 0 :type fixnum)
63     (signature-slot))
64    
65    
66    
67 chiles 1.1.1.5 ;;;; Macros.
68    
69 ram 1.1 ;;; The following Macros exist to make it easy to acces the Syntax primitives
70     ;;; without uglifying the code. They were originally written by Maddox.
71     ;;;
72    
73     (defmacro scan-char (mark attribute values)
74     `(find-attribute ,mark ',attribute ,(attr-predicate values)))
75    
76     (defmacro rev-scan-char (mark attribute values)
77     `(reverse-find-attribute ,mark ',attribute ,(attr-predicate values)))
78    
79     (defmacro test-char (char attribute values)
80     `(let ((x (character-attribute ',attribute ,char)))
81     ,(attr-predicate-aux values)))
82    
83     (eval-when (compile load eval)
84     (defun attr-predicate (values)
85     (cond ((eq values 't)
86     '#'plusp)
87     ((eq values 'nil)
88     '#'zerop)
89     (t `#'(lambda (x) ,(attr-predicate-aux values)))))
90    
91     (defun attr-predicate-aux (values)
92     (cond ((eq values t)
93     '(plusp x))
94     ((eq values nil)
95     '(zerop x))
96     ((symbolp values)
97     `(eq x ',values))
98     ((and (listp values) (member (car values) '(and or not)))
99     (cons (car values) (mapcar #'attr-predicate-aux (cdr values))))
100     (t (error "Illegal form in attribute pattern - ~S" values))))
101    
102     ); Eval-When (Compile Load Eval)
103    
104     ;;;
105     ;;; FIND-LISP-CHAR
106    
107     (defmacro find-lisp-char (mark)
108     "Move MARK to next :LISP-SYNTAX character, if one isn't found, return NIL."
109     `(find-attribute ,mark :lisp-syntax
110     #'(lambda (x)
111     (member x '(:open-paren :close-paren :newline :comment
112     :char-quote :string-quote)))))
113     ;;;
114     ;;; PUSH-RANGE
115    
116     (defmacro push-range (new-range info-struct)
117     "Insert NEW-RANGE into the LISP-INFO-RANGES-TO-IGNORE slot of the INFO-STRUCT."
118     `(when ,new-range
119     (setf (lisp-info-ranges-to-ignore ,info-struct)
120     (cons ,new-range (lisp-info-ranges-to-ignore ,info-struct)))))
121     ;;;
122     ;;; SCAN-DIRECTION
123    
124     (defmacro scan-direction (mark forwardp &rest forms)
125     "Expand to a form that scans either backward or forward according to Forwardp."
126     (if forwardp
127     `(scan-char ,mark ,@forms)
128     `(rev-scan-char ,mark ,@forms)))
129     ;;;
130     ;;; DIRECTION-CHAR
131    
132     (defmacro direction-char (mark forwardp)
133     "Expand to a form that returns either the previous or next character according
134     to Forwardp."
135     (if forwardp
136     `(next-character ,mark)
137     `(previous-character ,mark)))
138    
139     ;;;
140     ;;; NEIGHBOR-MARK
141    
142     (defmacro neighbor-mark (mark forwardp)
143     "Expand to a form that moves MARK either backward or forward one character,
144     depending on FORWARDP."
145     (if forwardp
146     `(mark-after ,mark)
147     `(mark-before ,mark)))
148    
149     ;;;
150     ;;; NEIGHBOR-LINE
151    
152     (defmacro neighbor-line (line forwardp)
153     "Expand to return the next or previous line, according to Forwardp."
154     (if forwardp
155     `(line-next ,line)
156     `(line-previous ,line)))
157    
158    
159 chiles 1.1.1.5 ;;;; Parsing functions.
160 ram 1.1
161 chiles 1.1.1.5 ;;; PRE-COMMAND-PARSE-CHECK -- Public.
162     ;;;
163 ram 1.1 (defun pre-command-parse-check (mark &optional (fer-sure-parse nil))
164     "Parse the area before the command is actually executed."
165     (with-mark ((top mark)
166     (bottom mark))
167     (funcall (value parse-start-function) top)
168     (funcall (value parse-end-function) bottom)
169     (parse-over-block (mark-line top) (mark-line bottom) fer-sure-parse)))
170    
171     ;;; PARSE-OVER-BLOCK
172 chiles 1.1.1.5 ;;;
173 ram 1.1 (defun parse-over-block (start-line end-line &optional (fer-sure-parse nil))
174     "Parse over an area indicated from END-LINE to START-LINE."
175     (let ((test-line start-line)
176     prev-line-info)
177    
178     (with-mark ((mark (mark test-line 0)))
179    
180     ; Set the pre-begining and post-ending lines to delimit the range
181     ; of action any command will take. This means set the lisp-info of the
182     ; lines immediately before and after the block to Nil.
183    
184     (when (line-previous start-line)
185     (setf (getf (line-plist (line-previous start-line)) 'lisp-info) nil))
186     (when (line-next end-line)
187     (setf (getf (line-plist (line-next end-line)) 'lisp-info) nil))
188    
189     (loop
190     (let ((line-info (getf (line-plist test-line) 'lisp-info)))
191    
192     ;; Reparse the line when any of the following are true:
193     ;;
194     ;; FER-SURE-PARSE is T
195     ;;
196     ;; LINE-INFO or PREV-LINE-INFO are Nil.
197     ;;
198     ;; If the line begins quoted and the previous one wasn't
199     ;; ended quoted.
200     ;;
201     ;; The Line's signature slot is invalid (the line has changed).
202     ;;
203    
204     (when (or fer-sure-parse
205     (not line-info)
206     (not prev-line-info)
207    
208     (not (eq (lisp-info-begins-quoted line-info)
209     (lisp-info-ending-quoted prev-line-info)))
210    
211     (not (eql (line-signature test-line)
212     (lisp-info-signature-slot line-info))))
213    
214     (move-to-position mark 0 test-line)
215    
216     (unless line-info
217     (setf line-info (make-lisp-info))
218     (setf (getf (line-plist test-line) 'lisp-info) line-info))
219    
220     (parse-lisp-line-info mark line-info prev-line-info))
221    
222     (when (eq end-line test-line)
223     (return nil))
224    
225     (setq prev-line-info line-info)
226    
227     (setq test-line (line-next test-line)))))))
228    
229    
230 chiles 1.1.1.5 ;;;; Parse block finders.
231 ram 1.1
232     (defhvar "Minimum Lines Parsed"
233     "The minimum number of lines before and after the point parsed by Lisp mode."
234     :value 50)
235     (defhvar "Maximum Lines Parsed"
236     "The maximum number of lines before and after the point parsed by Lisp mode."
237     :value 500)
238     (defhvar "Defun Parse Goal"
239     "Lisp mode parses the region obtained by skipping this many defuns forward
240     and backward from the point unless this falls outside of the range specified
241     by \"Minimum Lines Parsed\" and \"Maximum Lines Parsed\"."
242     :value 2)
243    
244    
245     (macrolet ((frob (step end)
246     `(let ((min (value minimum-lines-parsed))
247     (max (value maximum-lines-parsed))
248     (goal (value defun-parse-goal))
249     (last-defun nil))
250     (declare (fixnum min max goal))
251     (do ((line (mark-line mark) (,step line))
252     (count 0 (1+ count)))
253     ((null line)
254     (,end mark))
255     (declare (fixnum count))
256     (when (char= (line-character line 0) #\()
257     (setq last-defun line)
258     (decf goal)
259     (when (and (<= goal 0) (>= count min))
260     (line-start mark line)
261     (return)))
262     (when (> count max)
263     (line-start mark (or last-defun line))
264     (return))))))
265    
266     (defun start-of-parse-block (mark)
267     (frob line-previous buffer-start))
268    
269     (defun end-of-parse-block (mark)
270     (frob line-next buffer-end)))
271    
272     ;;;
273     ;;; START-OF-SEARCH-LINE
274    
275     (defun start-of-search-line (line)
276     "Set LINE to the begining line of the block of text to parse."
277     (with-mark ((mark (mark line 0)))
278     (funcall (value 'Parse-Start-Function) mark)
279     (setq line (mark-line mark))))
280    
281     ;;;
282     ;;; END-OF-SEACH-LINE
283    
284     (defun end-of-search-line (line)
285     "Set LINE to the ending line of the block of text to parse."
286     (with-mark ((mark (mark line 0)))
287     (funcall (value 'Parse-End-Function) mark)
288     (setq line (mark-line mark))))
289    
290    
291 chiles 1.1.1.5 ;;;; PARSE-LISP-LINE-INFO.
292    
293     ;;; PARSE-LISP-LINE-INFO -- Internal.
294     ;;;
295     ;;; This parses through the line doing the following things:
296     ;;;
297 ram 1.1 ;;; Counting/Setting the NET-OPEN-PARENS & NET-CLOSE-PARENS.
298 chiles 1.1.1.5 ;;;
299 ram 1.1 ;;; Making all areas of the line that should be invalid (comments,
300     ;;; char-quotes, and the inside of strings) and such be in
301     ;;; RANGES-TO-IGNORE.
302     ;;;
303     ;;; Set BEGINS-QUOTED and ENDING-QUOTED
304 chiles 1.1.1.5 ;;;
305 ram 1.1 (defun parse-lisp-line-info (mark line-info prev-line-info)
306     "Parse line and set line information like NET-OPEN-PARENS, NET-CLOSE-PARENS,
307 chiles 1.1.1.5 RANGES-TO-INGORE, and ENDING-QUOTED."
308 ram 1.1 (let ((net-open-parens 0)
309     (net-close-parens 0))
310     (declare (fixnum net-open-parens net-close-parens))
311    
312     ;; Re-set the slots necessary
313    
314     (setf (lisp-info-ranges-to-ignore line-info) nil)
315    
316     ;; The only way the current line begins quoted is when there
317     ;; is a previous line and it's ending was quoted.
318    
319     (setf (lisp-info-begins-quoted line-info)
320     (and prev-line-info
321     (lisp-info-ending-quoted prev-line-info)))
322    
323     (if (lisp-info-begins-quoted line-info)
324     (deal-with-string-quote mark line-info)
325     (setf (lisp-info-ending-quoted line-info) nil))
326    
327     (unless (lisp-info-ending-quoted line-info)
328     (loop
329     (find-lisp-char mark)
330     (ecase (character-attribute :lisp-syntax (next-character mark))
331    
332     (:open-paren
333     (setq net-open-parens (1+ net-open-parens))
334     (mark-after mark))
335    
336     (:close-paren
337     (if (zerop net-open-parens)
338     (setq net-close-parens (1+ net-close-parens))
339     (setq net-open-parens (1- net-open-parens)))
340     (mark-after mark))
341    
342     (:newline
343     (setf (lisp-info-ending-quoted line-info) nil)
344     (return t))
345    
346     (:comment
347     (push-range (cons (mark-charpos mark) (line-length (mark-line mark)))
348     line-info)
349     (setf (lisp-info-ending-quoted line-info) nil)
350     (return t))
351    
352     (:char-quote
353     (mark-after mark)
354     (push-range (cons (mark-charpos mark) (1+ (mark-charpos mark)))
355     line-info)
356     (mark-after mark))
357    
358     (:string-quote
359     (mark-after mark)
360     (unless (deal-with-string-quote mark line-info)
361     (setf (lisp-info-ending-quoted line-info) t)
362     (return t))))))
363    
364     (setf (lisp-info-net-open-parens line-info) net-open-parens)
365     (setf (lisp-info-net-close-parens line-info) net-close-parens)
366     (setf (lisp-info-signature-slot line-info)
367     (line-signature (mark-line mark)))))
368 chiles 1.1.1.5
369    
370 ram 1.1
371 chiles 1.1.1.5 ;;;; String quote utilities.
372 ram 1.1
373 chiles 1.1.1.5 ;;; VALID-STRING-QUOTE-P
374     ;;;
375 ram 1.1 (defmacro valid-string-quote-p (mark forwardp)
376     "Return T if the string-quote indicated by MARK is valid."
377     (let ((test-mark (gensym)))
378     `(with-mark ((,test-mark ,mark))
379 chiles 1.1.1.5 ,(unless forwardp
380     ;; TEST-MARK should always be right before the String-quote to be
381     ;; checked.
382     `(mark-before ,test-mark))
383 ram 1.1 (when (test-char (next-character ,test-mark) :lisp-syntax :string-quote)
384     (let ((slash-count 0))
385     (loop
386     (mark-before ,test-mark)
387     (if (test-char (next-character ,test-mark) :lisp-syntax :char-quote)
388     (incf slash-count)
389     (return t)))
390     (not (oddp slash-count)))))))
391    
392     ;;;
393     ;;; FIND-VALID-STRING-QUOTE
394    
395     (defmacro find-valid-string-quote (mark &key forwardp (cease-at-eol nil))
396     "Expand to a form that will leave MARK before a valid string-quote character,
397     in either a forward or backward direction, according to FORWARDP. If
398     CEASE-AT-EOL is T then it will return nil if encountering the EOL before a
399     valid string-quote."
400     (let ((e-mark (gensym)))
401     `(with-mark ((,e-mark ,mark))
402    
403     (loop
404     (unless (scan-direction ,e-mark ,forwardp :lisp-syntax
405     ,(if cease-at-eol
406     `(or :newline :string-quote)
407     `:string-quote))
408     (return nil))
409    
410     ,@(if cease-at-eol
411     `((when (test-char (direction-char ,e-mark ,forwardp) :lisp-syntax
412     :newline)
413     (return nil))))
414    
415     (when (valid-string-quote-p ,e-mark ,forwardp)
416     (move-mark ,mark ,e-mark)
417     (return t))
418    
419     (neighbor-mark ,e-mark ,forwardp)))))
420    
421 chiles 1.1.1.5 ;;;; DEAL-WITH-STRING-QUOTE.
422 ram 1.1
423 chiles 1.1.1.5 ;;; DEAL-WITH-STRING-QUOTE
424     ;;;
425     ;;; Called when a string is begun (i.e. parse hits a #\"). It checks for a
426     ;;; matching quote on the line that MARK points to, and puts the appropriate
427     ;;; area in the RANGES-TO-IGNORE slot and leaves MARK pointing after this area.
428     ;;; The "appropriate area" is from MARK to the end of the line or the matching
429     ;;; string-quote, whichever comes first.
430     ;;;
431 ram 1.1 (defun deal-with-string-quote (mark info-struct)
432     "Alter the current line's info struct as necessary as due to encountering a
433 chiles 1.1.1.5 string quote character."
434 ram 1.1 (with-mark ((e-mark mark))
435     (cond ((find-valid-string-quote e-mark :forwardp t :cease-at-eol t)
436 chiles 1.1.1.5 ;; If matching quote is on this line then mark the area between the
437     ;; first quote (MARK) and the matching quote as invalid by pushing
438     ;; its begining and ending into the IGNORE-RANGE.
439 ram 1.1 (push-range (cons (mark-charpos mark) (mark-charpos e-mark))
440     info-struct)
441     (setf (lisp-info-ending-quoted info-struct) nil)
442     (mark-after e-mark)
443     (move-mark mark e-mark))
444 chiles 1.1.1.5 ;; If the EOL has been hit before the matching quote then mark the
445     ;; area from MARK to the EOL as invalid.
446 ram 1.1 (t
447 chiles 1.1.1.5 (push-range (cons (mark-charpos mark)
448     (1+ (line-length (mark-line mark))))
449 ram 1.1 info-struct)
450     ;; The Ending is marked as still being quoted.
451     (setf (lisp-info-ending-quoted info-struct) t)
452     (line-end mark)
453     nil))))
454 chiles 1.1.1.5
455    
456 ram 1.1
457     ;;;; Character validity checking:
458    
459     ;;; Find-Ignore-Region -- Internal
460     ;;;
461     ;;; If the character in the specified direction from Mark is in an ignore
462     ;;; region, then return the region and the line that the region is in as
463     ;;; values. If there is no ignore region, then return NIL and the Mark-Line.
464     ;;; If the line is not parsed, or there is no character (because of being at
465     ;;; the buffer beginning or end), then return both values NIL.
466     ;;;
467     (defun find-ignore-region (mark forwardp)
468     (flet ((scan (line pos)
469     (declare (fixnum pos))
470     (let ((info (getf (line-plist line) 'lisp-info)))
471     (if info
472     (dolist (range (lisp-info-ranges-to-ignore info)
473     (values nil line))
474     (let ((start (car range))
475     (end (cdr range)))
476     (declare (fixnum start end))
477     (when (and (>= pos start) (< pos end))
478     (return (values range line)))))
479     (values nil nil)))))
480     (let ((pos (mark-charpos mark))
481     (line (mark-line mark)))
482     (declare (fixnum pos))
483     (cond (forwardp (scan line pos))
484     ((> pos 0) (scan line (1- pos)))
485     (t
486     (let ((prev (line-previous line)))
487     (if prev
488     (scan prev (line-length prev))
489     (values nil nil))))))))
490    
491    
492     ;;; Valid-Spot -- Public
493     ;;;
494     (defun valid-spot (mark forwardp)
495     "Return true if the character pointed to by Mark is not in a quoted context,
496     false otherwise. If Forwardp is true, we use the next character, otherwise
497     we use the previous."
498     (multiple-value-bind (region line)
499     (find-ignore-region mark forwardp)
500     (and line (not region))))
501    
502    
503     ;;; Scan-Direction-Valid -- Internal
504     ;;;
505     ;;; Like scan-direction, but only stop on valid characters.
506     ;;;
507     (defmacro scan-direction-valid (mark forwardp &rest forms)
508     (let ((n-mark (gensym))
509     (n-line (gensym))
510     (n-region (gensym))
511     (n-won (gensym)))
512     `(let ((,n-mark ,mark) (,n-won nil))
513     (loop
514     (multiple-value-bind (,n-region ,n-line)
515     (find-ignore-region ,n-mark ,forwardp)
516     (unless ,n-line (return nil))
517     (if ,n-region
518     (move-to-position ,n-mark
519     ,(if forwardp
520     `(cdr ,n-region)
521     `(car ,n-region))
522     ,n-line)
523     (when ,n-won (return t)))
524     ;;
525     ;; Peculiar condition when a quoting character terminates a line.
526     ;; The ignore region is off the end of the line causing %FORM-OFFSET
527     ;; to infinitely loop.
528     (when (> (mark-charpos ,n-mark) (line-length ,n-line))
529     (line-offset ,n-mark 1 0))
530     (unless (scan-direction ,n-mark ,forwardp ,@forms)
531     (return nil))
532     (setq ,n-won t))))))
533    
534    
535 chiles 1.1.1.5 ;;;; List offseting.
536    
537 ram 1.1 ;;; %LIST-OFFSET allows for BACKWARD-LIST and FORWARD-LIST to be built
538     ;;; with the same existing structure, with the altering of one variable.
539     ;;; This one variable being FORWARDP.
540     ;;;
541     (defmacro %list-offset (actual-mark forwardp &key (extra-parens 0) )
542     "Expand to code that will go forward one list either backward or forward,
543 chiles 1.1.1.5 according to the FORWARDP flag."
544 ram 1.1 (let ((mark (gensym)))
545     `(let ((paren-count ,extra-parens))
546     (declare (fixnum paren-count))
547     (with-mark ((,mark ,actual-mark))
548     (loop
549     (scan-direction ,mark ,forwardp :lisp-syntax
550     (or :close-paren :open-paren :newline))
551     (let ((ch (direction-char ,mark ,forwardp)))
552     (unless ch (return nil))
553     (when (valid-spot ,mark ,forwardp)
554     (case (character-attribute :lisp-syntax ch)
555     (:close-paren
556     (decf paren-count)
557 chiles 1.1.1.5 ,(when forwardp
558     ;; When going forward, an unmatching close-paren means the
559     ;; end of list.
560     `(when (<= paren-count 0)
561 ram 1.1 (neighbor-mark ,mark ,forwardp)
562     (move-mark ,actual-mark ,mark)
563     (return t))))
564     (:open-paren
565     (incf paren-count)
566     ,(unless forwardp ; Same as above only end of list
567     `(when (>= paren-count 0) ; is opening parens.
568     (neighbor-mark ,mark ,forwardp)
569     (move-mark ,actual-mark ,mark)
570     (return t))))
571    
572     (:newline
573 chiles 1.1.1.5 ;; When a #\Newline is hit, then the matching paren must lie
574     ;; on some other line so drop down into the multiple line
575     ;; balancing function: QUEST-FOR-BALANCING-PAREN If no paren
576     ;; seen yet, keep going.
577 ram 1.1 (cond ((zerop paren-count))
578     ((quest-for-balancing-paren ,mark paren-count ,forwardp)
579     (move-mark ,actual-mark ,mark)
580     (return t))
581     (t
582     (return nil)))))))
583    
584     (neighbor-mark ,mark ,forwardp))))))
585    
586     ;;;
587     ;;; QUEST-FOR-BALANCING-PAREN
588    
589     (defmacro quest-for-balancing-paren (mark paren-count forwardp)
590     "Expand to a form that finds the the balancing paren for however many opens or
591     closes are registered by Paren-Count."
592     `(let* ((line (mark-line ,mark)))
593     (loop
594     (setq line (neighbor-line line ,forwardp))
595     (unless line (return nil))
596     (let ((line-info (getf (line-plist line) 'lisp-info))
597     (unbal-paren ,paren-count))
598     (unless line-info (return nil))
599    
600     ,(if forwardp
601     `(decf ,paren-count (lisp-info-net-close-parens line-info))
602     `(incf ,paren-count (lisp-info-net-open-parens line-info)))
603    
604     (when ,(if forwardp
605     `(<= ,paren-count 0)
606     `(>= ,paren-count 0))
607     ,(if forwardp
608     `(line-start ,mark line)
609     `(line-end ,mark line))
610     (return (goto-correct-paren-char ,mark unbal-paren ,forwardp)))
611    
612     ,(if forwardp
613     `(incf ,paren-count (lisp-info-net-open-parens line-info))
614     `(decf ,paren-count (lisp-info-net-close-parens line-info)))))))
615    
616    
617     ;;;
618     ;;; GOTO-CORRECT-PAREN-CHAR
619    
620     (defmacro goto-correct-paren-char (mark paren-count forwardp)
621     "Expand to a form that will leave MARK on the correct balancing paren matching
622     however many are indicated by COUNT."
623     `(with-mark ((m ,mark))
624     (let ((count ,paren-count))
625     (loop
626     (scan-direction m ,forwardp :lisp-syntax
627     (or :close-paren :open-paren :newline))
628     (when (valid-spot m ,forwardp)
629     (ecase (character-attribute :lisp-syntax (direction-char m ,forwardp))
630     (:close-paren
631     (decf count)
632     ,(when forwardp
633     `(when (zerop count)
634     (neighbor-mark m ,forwardp)
635     (move-mark ,mark m)
636     (return t))))
637    
638     (:open-paren
639     (incf count)
640     ,(unless forwardp
641     `(when (zerop count)
642     (neighbor-mark m ,forwardp)
643     (move-mark ,mark m)
644     (return t))))))
645     (neighbor-mark m ,forwardp)))))
646    
647    
648     (defun list-offset (mark offset)
649     (if (plusp offset)
650     (dotimes (i offset t)
651     (unless (%list-offset mark t) (return nil)))
652     (dotimes (i (- offset) t)
653     (unless (%list-offset mark nil) (return nil)))))
654    
655     (defun forward-up-list (mark)
656     "Moves mark just past the closing paren of the immediately containing list."
657     (%list-offset mark t :extra-parens 1))
658    
659     (defun backward-up-list (mark)
660     "Moves mark just before the opening paren of the immediately containing list."
661     (%list-offset mark nil :extra-parens -1))
662    
663    
664    
665     ;;;; Top level form location hacks (open parens beginning lines).
666    
667     ;;; NEIGHBOR-TOP-LEVEL is used only in TOP-LEVEL-OFFSET.
668     ;;;
669     (eval-when (compile eval)
670     (defmacro neighbor-top-level (line forwardp)
671     `(loop
672     (when (test-char (line-character ,line 0) :lisp-syntax :open-paren)
673     (return t))
674     (setf ,line ,(if forwardp `(line-next ,line) `(line-previous ,line)))
675     (unless ,line (return nil))))
676     ) ;eval-when
677    
678     (defun top-level-offset (mark offset)
679     "Go forward or backward offset number of top level forms. Mark is
680     returned if offset forms exists, otherwise nil."
681     (declare (fixnum offset))
682     (let* ((line (mark-line mark))
683     (at-start (test-char (line-character line 0) :lisp-syntax :open-paren)))
684     (cond ((zerop offset) mark)
685     ((plusp offset)
686     (do ((offset (if at-start offset (1- offset))
687     (1- offset)))
688     (nil)
689     (declare (fixnum offset))
690     (unless (neighbor-top-level line t) (return nil))
691     (when (zerop offset) (return (line-start mark line)))
692     (unless (setf line (line-next line)) (return nil))))
693     (t
694     (do ((offset (if (and at-start (start-line-p mark))
695     offset
696     (1+ offset))
697     (1+ offset)))
698     (nil)
699     (declare (fixnum offset))
700     (unless (neighbor-top-level line nil) (return nil))
701     (when (zerop offset) (return (line-start mark line)))
702     (unless (setf line (line-previous line)) (return nil)))))))
703    
704    
705     (defun mark-top-level-form (mark1 mark2)
706     "Moves mark1 and mark2 to the beginning and end of the current or next defun.
707     Mark1 one is used as a reference. The marks may be altered even if
708     unsuccessful. if successful, return mark2, else nil."
709     (let ((winp (cond ((inside-defun-p mark1)
710     (cond ((not (top-level-offset mark1 -1)) nil)
711     ((not (form-offset (move-mark mark2 mark1) 1)) nil)
712     (t mark2)))
713     ((start-defun-p mark1)
714     (form-offset (move-mark mark2 mark1) 1))
715     ((and (top-level-offset (move-mark mark2 mark1) -1)
716     (start-defun-p mark2)
717     (form-offset mark2 1)
718     (same-line-p mark1 mark2))
719     (form-offset (move-mark mark1 mark2) -1)
720     mark2)
721     ((top-level-offset mark1 1)
722     (form-offset (move-mark mark2 mark1) 1)))))
723     (when winp
724     (when (blank-after-p mark2) (line-offset mark2 1 0))
725     mark2)))
726    
727     (defun inside-defun-p (mark)
728     "T if the current point is (supposedly) in a top level form."
729     (with-mark ((m mark))
730     (when (top-level-offset m -1)
731     (form-offset m 1)
732     (mark> m mark))))
733    
734     (defun start-defun-p (mark)
735     "Returns t if mark is sitting before an :open-paren at the beginning of a
736     line."
737     (and (start-line-p mark)
738     (test-char (next-character mark) :lisp-syntax :open-paren)))
739    
740    
741    
742 chiles 1.1.1.5 ;;;; Form offseting.
743 ram 1.1
744     (defmacro %form-offset (mark forwardp)
745     `(with-mark ((m ,mark))
746     (when (scan-direction-valid m ,forwardp :lisp-syntax
747     (or :open-paren :close-paren
748     :char-quote :string-quote
749     :constituent))
750     (ecase (character-attribute :lisp-syntax (direction-char m ,forwardp))
751     (:open-paren
752     (when ,(if forwardp `(list-offset m 1) `(mark-before m))
753     ,(unless forwardp
754     '(scan-direction m nil :lisp-syntax (not :prefix)))
755     (move-mark ,mark m)
756     t))
757     (:close-paren
758     (when ,(if forwardp `(mark-after m) `(list-offset m -1))
759     ,(unless forwardp
760     '(scan-direction m nil :lisp-syntax (not :prefix)))
761     (move-mark ,mark m)
762     t))
763     ((:constituent :char-quote)
764     (scan-direction-valid m ,forwardp :lisp-syntax
765     (not (or :constituent :char-quote)))
766     ,(if forwardp
767     `(scan-direction-valid m t :lisp-syntax
768     (not (or :constituent :char-quote)))
769     `(scan-direction-valid m nil :lisp-syntax
770     (not (or :constituent :char-quote
771     :prefix))))
772     (move-mark ,mark m)
773     t)
774     (:string-quote
775     (cond ((valid-spot m ,(not forwardp))
776     (neighbor-mark m ,forwardp)
777     (when (scan-direction-valid m ,forwardp :lisp-syntax
778     :string-quote)
779     (neighbor-mark m ,forwardp)
780     (move-mark ,mark m)
781     t))
782     (t (neighbor-mark m ,forwardp)
783     (move-mark ,mark m)
784     t)))))))
785    
786    
787     (defun form-offset (mark offset)
788     "Move mark offset number of forms, after if positive, before if negative.
789     Mark is always moved. If there weren't enough forms, returns nil instead of
790     mark."
791     (if (plusp offset)
792     (dotimes (i offset t)
793     (unless (%form-offset mark t) (return nil)))
794     (dotimes (i (- offset) t)
795     (unless (%form-offset mark nil) (return nil)))))
796    
797    
798    
799 chiles 1.1.1.5 ;;;; Table of special forms with special indenting requirements.
800 ram 1.1
801     (defhvar "Indent Defanything"
802     "This is the number of special arguments implicitly assumed to be supplied
803     in calls to functions whose names begin with \"DEF\". If set to NIL, this
804     feature is disabled."
805     :value 2)
806    
807     (defvar *special-forms* (make-hash-table :test #'equal))
808    
809     (defun defindent (fname args)
810     "Define Fname to have Args special arguments. If args is null then remove
811     any special arguments information."
812     (check-type fname string)
813     (let ((fname (string-upcase fname)))
814     (cond ((null args) (remhash fname *special-forms*))
815     (t
816     (check-type args integer)
817     (setf (gethash fname *special-forms*) args)))))
818    
819    
820     ;;; Hemlock forms.
821     ;;;
822     (defindent "with-mark" 1)
823     (defindent "with-random-typeout" 1)
824     (defindent "with-pop-up-display" 1)
825     (defindent "defhvar" 1)
826     (defindent "hlet" 1)
827     (defindent "defcommand" 2)
828     (defindent "defattribute" 1)
829     (defindent "command-case" 1)
830     (defindent "with-input-from-region" 1)
831     (defindent "with-output-to-mark" 1)
832     (defindent "with-output-to-window" 1)
833     (defindent "do-strings" 1)
834     (defindent "save-for-undo" 1)
835     (defindent "do-alpha-chars" 1)
836     (defindent "do-headers-buffers" 1)
837     (defindent "do-headers-lines" 1)
838     (defindent "with-headers-mark" 1)
839     (defindent "frob" 1) ;cover silly FLET and MACROLET names for Rob and Bill.
840     (defindent "with-writable-buffer" 1)
841    
842     ;;; Common Lisp forms.
843     ;;;
844     (defindent "block" 1)
845     (defindent "case" 1)
846     (defindent "catch" 1)
847     (defindent "ccase" 1)
848     (defindent "compiler-let" 1)
849     (defindent "ctypecase" 1)
850     (defindent "defconstant" 1)
851     (defindent "define-setf-method" 2)
852     (defindent "defmacro" 2)
853     (defindent "defparameter" 1)
854     (defindent "defstruct" 1)
855     (defindent "deftype" 2)
856     (defindent "defun" 2)
857     (defindent "defvar" 1)
858     (defindent "do" 2)
859     (defindent "do*" 2)
860     (defindent "do-all-symbols" 1)
861     (defindent "do-external-symbols" 1)
862     (defindent "do-symbols" 1)
863     (defindent "dolist" 1)
864     (defindent "dotimes" 1)
865     (defindent "ecase" 1)
866     (defindent "etypecase" 1)
867     (defindent "eval-when" 1)
868     (defindent "flet" 1)
869     (defindent "labels" 1)
870     (defindent "lambda" 1)
871     (defindent "let" 1)
872     (defindent "let*" 1)
873     (defindent "loop" 0)
874     (defindent "macrolet" 1)
875     (defindent "multiple-value-bind" 2)
876     (defindent "multiple-value-call" 1)
877     (defindent "multiple-value-prog1" 1)
878     (defindent "multiple-value-setq" 1)
879     (defindent "prog1" 1)
880     (defindent "progv" 2)
881     (defindent "progn" 0)
882     (defindent "typecase" 1)
883     (defindent "unless" 1)
884     (defindent "unwind-protect" 1)
885     (defindent "when" 1)
886     (defindent "with-input-from-string" 1)
887     (defindent "with-open-file" 1)
888     (defindent "with-open-stream" 1)
889     (defindent "with-output-to-string" 1)
890    
891     ;;; Error/condition system forms.
892     ;;;
893     (defindent "define-condition" 2)
894     (defindent "handler-bind" 1)
895     (defindent "handler-case" 1)
896     (defindent "restart-bind" 1)
897     (defindent "restart-case" 1)
898     (defindent "with-simple-restart" 1)
899     ;;; These are for RESTART-CASE branch formatting.
900     (defindent "store-value" 1)
901     (defindent "use-value" 1)
902     (defindent "muffle-warning" 1)
903     (defindent "abort" 1)
904     (defindent "continue" 1)
905 chiles 1.1.1.7
906     ;;; Debug-internals forms.
907     ;;;
908 chiles 1.1.1.12 (defindent "do-debug-function-blocks" 1)
909     (defindent "di:do-debug-function-blocks" 1)
910 chiles 1.1.1.7 (defindent "do-debug-function-variables" 1)
911     (defindent "di:do-debug-function-variables" 1)
912     (defindent "do-debug-block-locations" 1)
913     (defindent "di:do-debug-block-locations" 1)
914     ;;;
915     ;;; Debug-internals conditions
916     ;;; (define these to make uses of HANDLER-CASE indent branches correctly.)
917     ;;;
918     (defindent "debug-condition" 1)
919     (defindent "di:debug-condition" 1)
920     (defindent "no-debug-info" 1)
921     (defindent "di:no-debug-info" 1)
922     (defindent "no-debug-function-returns" 1)
923     (defindent "di:no-debug-function-returns" 1)
924     (defindent "no-debug-blocks" 1)
925     (defindent "di:no-debug-blocks" 1)
926     (defindent "lambda-list-unavailable" 1)
927     (defindent "di:lambda-list-unavailable" 1)
928     (defindent "no-debug-variables" 1)
929     (defindent "di:no-debug-variables" 1)
930     (defindent "invalid-value" 1)
931     (defindent "di:invalid-value" 1)
932     (defindent "ambiguous-variable-name" 1)
933     (defindent "di:ambiguous-variable-name" 1)
934     (defindent "debug-error" 1)
935     (defindent "di:debug-error" 1)
936     (defindent "unhandled-condition" 1)
937     (defindent "di:unhandled-condition" 1)
938     (defindent "unknown-code-location" 1)
939     (defindent "di:unknown-code-location" 1)
940     (defindent "unknown-debug-variable" 1)
941     (defindent "di:unknown-debug-variable" 1)
942     (defindent "invalid-control-stack-pointer" 1)
943     (defindent "di:invalid-control-stack-pointer" 1)
944     (defindent "frame-function-mismatch" 1)
945     (defindent "di:frame-function-mismatch" 1)
946 ram 1.1
947     ;;; Xlib forms.
948     ;;;
949     (defindent "with-gcontext" 1)
950     (defindent "xlib:with-gcontext" 1)
951     (defindent "with-state" 1)
952     (defindent "xlib:with-state" 1)
953     (defindent "with-display" 1)
954     (defindent "xlib:with-display" 1)
955     (defindent "with-event-queue" 1)
956     (defindent "xlib:with-event-queue" 1)
957     (defindent "with-server-grabbed" 1)
958     (defindent "xlib:with-server-grabbed" 1)
959     (defindent "event-case" 1)
960     (defindent "xlib:event-case" 1)
961    
962     ;;; CLOS forms.
963     ;;;
964     (defindent "with-slots" 1)
965     (defindent "with-slots*" 2)
966     (defindent "with-accessors*" 2)
967     (defindent "defclass" 2)
968    
969     ;;; System forms.
970     ;;;
971     (defindent "alien-bind" 1)
972     (defindent "def-c-record" 1)
973     (defindent "defrecord" 1)
974 chiles 1.1.1.12
975     ;;; Wire forms.
976     (defindent "remote" 1)
977     (defindent "wire:remote" 1)
978     (defindent "remote-value" 1)
979     (defindent "wire:remote-value" 1)
980     (defindent "remote-value-bind" 3)
981     (defindent "wire:remote-value-bind" 3)
982 ram 1.1
983    
984    
985 chiles 1.1.1.5 ;;;; Indentation.
986    
987     ;;; LISP-INDENTATION -- Internal Interface.
988     ;;;
989 ram 1.1 (defun lisp-indentation (mark)
990 chiles 1.1.1.6 "Compute number of spaces which mark should be indented according to
991     local context and lisp grinding conventions. This assumes mark is at the
992     beginning of the line to be indented."
993 ram 1.1 (with-mark ((m mark)
994     (temp mark))
995 chiles 1.1.1.8 ;; See if we are in a quoted context.
996 ram 1.1 (unless (valid-spot m nil)
997 chiles 1.1.1.5 (return-from lisp-indentation (lisp-generic-indentation m)))
998 chiles 1.1.1.8 ;; Look for the paren that opens the containing form.
999 ram 1.1 (unless (backward-up-list m)
1000     (return-from lisp-indentation 0))
1001 chiles 1.1.1.8 ;; Move after the paren, save the start, and find the form name.
1002 ram 1.1 (mark-after m)
1003     (with-mark ((start m))
1004 chiles 1.1.1.5 (unless (and (scan-char m :lisp-syntax
1005     (not (or :space :prefix :char-quote)))
1006 ram 1.1 (test-char (next-character m) :lisp-syntax :constituent))
1007     (return-from lisp-indentation (mark-column start)))
1008     (with-mark ((fstart m))
1009     (scan-char m :lisp-syntax (not :constituent))
1010     (let* ((fname (nstring-upcase (region-to-string (region fstart m))))
1011     (special-args (or (gethash fname *special-forms*)
1012     (and (> (length fname) 2)
1013     (string= fname "DEF" :end1 3)
1014     (value indent-defanything)))))
1015     (declare (simple-string fname))
1016 chiles 1.1.1.8 ;; Now that we have the form name, did it have special syntax?
1017 ram 1.1 (cond (special-args
1018     (with-mark ((spec m))
1019     (cond ((and (form-offset spec special-args)
1020     (mark<= spec mark))
1021     (1+ (mark-column start)))
1022     ((skip-valid-space m)
1023     (mark-column m))
1024     (t
1025     (+ (mark-column start) 3)))))
1026 chiles 1.1.1.8 ;; See if the user seems to have altered the editor's
1027     ;; indentation, and if so, try to adhere to it. This usually
1028     ;; happens when you type in a quoted list constant that line
1029     ;; wraps. You want all the items on successive lines to fall
1030     ;; under the first character after the opening paren, not as if
1031     ;; you are calling a function.
1032 ram 1.1 ((and (form-offset temp -1)
1033 chiles 1.1.1.5 (or (blank-before-p temp) (not (same-line-p temp fstart)))
1034 ram 1.1 (not (same-line-p temp mark)))
1035     (unless (blank-before-p temp)
1036     (line-start temp)
1037     (find-attribute temp :space #'zerop))
1038     (mark-column temp))
1039 chiles 1.1.1.8 ;; Appears to be a normal form. Is the first arg on the same
1040     ;; line as the form name?
1041 ram 1.1 ((skip-valid-space m)
1042 chiles 1.1.1.8 (or (lisp-indentation-check-for-local-def
1043     mark temp fstart start t)
1044     (mark-column m)))
1045     ;; Okay, fall under the first character after the opening paren.
1046 ram 1.1 (t
1047 chiles 1.1.1.8 (or (lisp-indentation-check-for-local-def
1048     mark temp fstart start nil)
1049     (mark-column start)))))))))
1050    
1051 ram 1.1.1.14 (defhvar "Lisp Indentation Local Definers"
1052     "Forms with syntax like LABELS, MACROLET, etc."
1053     :value '("LABELS" "MACROLET" "FLET"))
1054    
1055 chiles 1.1.1.8 ;;; LISP-INDENTATION-CHECK-FOR-LOCAL-DEF -- Internal.
1056     ;;;
1057     ;;; This is a temporary hack to see how it performs. When we are indenting
1058     ;;; what appears to be a function call, let's look for FLET or MACROLET to see
1059     ;;; if we really are indenting a local definition. If we are, return the
1060     ;;; indentation for a DEFUN; otherwise, nil
1061     ;;;
1062     ;;; Mark is the argument to LISP-INDENTATION. Start is just inside the paren
1063     ;;; of what looks like a function call. If we are in an FLET, arg-list
1064     ;;; indicates whether the local function's arg-list has been entered, that is,
1065     ;;; whether we need to normally indent for a DEFUN body or indent specially for
1066     ;;; the arg-list.
1067     ;;;
1068     (defun lisp-indentation-check-for-local-def (mark temp1 temp2 start arg-list)
1069     ;; We know this succeeds from LISP-INDENTATION.
1070 chiles 1.1.1.9 (backward-up-list (move-mark temp1 mark)) ;Paren for local definition.
1071     (cond ((and (backward-up-list temp1) ;Paren opening the list of defs
1072 ram 1.1.1.15 (form-offset (move-mark temp2 temp1) -1)
1073     (mark-before temp2)
1074     (backward-up-list temp1) ;Paren for FLET or MACROLET.
1075     (mark= temp1 temp2)) ;Must be in first arg form.
1076 chiles 1.1.1.9 ;; See if the containing form is named FLET or MACROLET.
1077 chiles 1.1.1.8 (mark-after temp1)
1078     (unless (and (scan-char temp1 :lisp-syntax
1079     (not (or :space :prefix :char-quote)))
1080     (test-char (next-character temp1) :lisp-syntax
1081     :constituent))
1082     (return-from lisp-indentation-check-for-local-def nil))
1083     (move-mark temp2 temp1)
1084     (scan-char temp2 :lisp-syntax (not :constituent))
1085     (let ((fname (nstring-upcase (region-to-string (region temp1 temp2)))))
1086 ram 1.1.1.14 (cond ((not (member fname (value lisp-indentation-local-definers)
1087     :test #'string=))
1088 chiles 1.1.1.8 nil)
1089     (arg-list
1090     (1+ (mark-column start)))
1091     (t
1092     (+ (mark-column start) 3)))))))
1093 ram 1.1
1094 chiles 1.1.1.6 ;;; LISP-GENERIC-INDENTATION -- Internal.
1095     ;;;
1096     ;;; LISP-INDENTATION calls this when mark is in a invalid spot, or quoted
1097     ;;; context. If we are inside a string, we return the column one greater
1098     ;;; than the opening double quote. Otherwise, we just use the indentation
1099     ;;; of the first preceding non-blank line.
1100     ;;;
1101 ram 1.1 (defun lisp-generic-indentation (mark)
1102 chiles 1.1.1.6 (with-mark ((m mark))
1103     (form-offset m -1)
1104     (cond ((eq (character-attribute :lisp-syntax (next-character m))
1105     :string-quote)
1106     (1+ (mark-column m)))
1107     (t
1108     (let* ((line (mark-line mark))
1109     (prev (do ((line (line-previous line) (line-previous line)))
1110     ((not (and line (blank-line-p line))) line))))
1111     (cond (prev
1112     (line-start mark prev)
1113     (find-attribute mark :space #'zerop)
1114     (mark-column mark))
1115     (t 0)))))))
1116 ram 1.1
1117     ;;; Skip-Valid-Space -- Internal
1118     ;;;
1119     ;;; Skip over any space on the line Mark is on, stopping at the first valid
1120     ;;; non-space character. If there is none on the line, return nil.
1121     ;;;
1122     (defun skip-valid-space (mark)
1123     (loop
1124     (scan-char mark :lisp-syntax (not :space))
1125     (let ((val (character-attribute :lisp-syntax
1126     (next-character mark))))
1127     (cond ((eq val :newline) (return nil))
1128     ((valid-spot mark t) (return mark))))
1129     (mark-after mark)))
1130    
1131 chiles 1.1.1.10
1132 ram 1.1
1133 chiles 1.1.1.10 ;;;; Indentation commands and hook functions.
1134 ram 1.1
1135     (defcommand "Defindent" (p)
1136     "Define the Lisp indentation for the current function.
1137     The indentation is a non-negative integer which is the number
1138     of special arguments for the form. Examples: 2 for Do, 1 for Dolist.
1139     If a prefix argument is supplied, then delete the indentation information."
1140     "Do a defindent, man!"
1141     (with-mark ((m (current-point)))
1142     (pre-command-parse-check m)
1143     (unless (backward-up-list m) (editor-error))
1144     (mark-after m)
1145     (with-mark ((n m))
1146     (scan-char n :lisp-syntax (not :constituent))
1147     (let ((s (region-to-string (region m n))))
1148     (declare (simple-string s))
1149     (when (zerop (length s)) (editor-error))
1150     (if p
1151     (defindent s nil)
1152     (let ((i (prompt-for-integer
1153     :prompt (format nil "Indentation for ~A: " s)
1154     :help "Number of special arguments.")))
1155     (when (minusp i)
1156     (editor-error "Indentation must be non-negative."))
1157     (defindent s i))))))
1158 chiles 1.1.1.10 (indent-command nil))
1159 ram 1.1
1160 chiles 1.1.1.10 (defcommand "Indent Form" (p)
1161     "Indent Lisp code in the next form."
1162     "Indent Lisp code in the next form."
1163     (declare (ignore p))
1164     (let ((point (current-point)))
1165     (pre-command-parse-check point)
1166     (with-mark ((m point))
1167     (unless (form-offset m 1) (editor-error))
1168     (lisp-indent-region (region point m) "Indent Form"))))
1169    
1170     ;;; LISP-INDENT-REGION -- Internal.
1171     ;;;
1172     ;;; This indents a region of Lisp code without doing excessive redundant
1173     ;;; computation. We parse the entire region once, then scan through doing
1174     ;;; indentation on each line. We forcibly reparse each line that we indent so
1175     ;;; that the list operations done to determine indentation of subsequent lines
1176     ;;; will work. This is done undoably with save1, save2, buf-region, and
1177     ;;; undo-region.
1178     ;;;
1179     (defun lisp-indent-region (region &optional (undo-text "Lisp region indenting"))
1180     (check-region-query-size region)
1181     (let ((start (region-start region))
1182     (end (region-end region)))
1183     (with-mark ((m1 start)
1184     (m2 end))
1185     (funcall (value parse-start-function) m1)
1186     (funcall (value parse-end-function) m2)
1187     (parse-over-block (mark-line m1) (mark-line m2)))
1188     (let* ((first-line (mark-line start))
1189     (last-line (mark-line end))
1190     (prev (line-previous first-line))
1191     (prev-line-info
1192     (and prev (getf (line-plist prev) 'lisp-info)))
1193     (save1 (line-start (copy-mark start :right-inserting)))
1194     (save2 (line-end (copy-mark end :left-inserting)))
1195     (buf-region (region save1 save2))
1196     (undo-region (copy-region buf-region)))
1197     (with-mark ((bol start :left-inserting))
1198     (do ((line first-line (line-next line)))
1199     (nil)
1200     (line-start bol line)
1201     (insert-lisp-indentation bol)
1202     (let ((line-info (getf (line-plist line) 'lisp-info)))
1203     (parse-lisp-line-info bol line-info prev-line-info)
1204     (setq prev-line-info line-info))
1205     (when (eq line last-line) (return nil))))
1206     (make-region-undo :twiddle undo-text buf-region undo-region))))
1207    
1208     ;;; INDENT-FOR-LISP -- Internal.
1209     ;;;
1210     ;;; This is the value of "Indent Function" for "Lisp" mode.
1211     ;;;
1212     (defun indent-for-lisp (mark)
1213     (line-start mark)
1214     (pre-command-parse-check mark)
1215     (insert-lisp-indentation mark))
1216    
1217     (defun insert-lisp-indentation (m)
1218     (delete-horizontal-space m)
1219     (funcall (value indent-with-tabs) m (lisp-indentation m)))
1220    
1221    
1222    
1223     ;;;; Most "Lisp" mode commands.
1224    
1225 ram 1.1 (defcommand "Beginning of Defun" (p)
1226     "Move the point to the beginning of a top-level form.
1227     with an argument, skips the previous p top-level forms."
1228     "Move the point to the beginning of a top-level form."
1229     (let ((point (current-point))
1230     (count (or p 1)))
1231     (pre-command-parse-check point)
1232     (if (minusp count)
1233     (end-of-defun-command (- count))
1234     (unless (top-level-offset point (- count))
1235     (editor-error)))))
1236    
1237     ;;; "End of Defun", with a positive p (the normal case), does something weird.
1238     ;;; Get a mark at the beginning of the defun, and then offset it forward one
1239     ;;; less top level form than we want. This sets us up to use FORM-OFFSET which
1240     ;;; allows us to leave the point immediately after the defun. If we used
1241     ;;; TOP-LEVEL-OFFSET one less than p on the mark at the end of the current
1242     ;;; defun, point would be left at the beginning of the p+1'st form instead of
1243     ;;; at the end of the p'th form.
1244     ;;;
1245     (defcommand "End of Defun" (p)
1246     "Move the point to the end of a top-level form.
1247     With an argument, skips the next p top-level forms."
1248     "Move the point to the end of a top-level form."
1249     (let ((point (current-point))
1250     (count (or p 1)))
1251     (pre-command-parse-check point)
1252     (if (minusp count)
1253     (beginning-of-defun-command (- count))
1254     (with-mark ((m point)
1255     (dummy point))
1256     (cond ((not (mark-top-level-form m dummy))
1257     (editor-error "No current or next top level form."))
1258     (t
1259     (unless (top-level-offset m (1- count))
1260     (editor-error "Not enough top level forms."))
1261     ;; We might be one unparsed for away.
1262     (pre-command-parse-check m)
1263     (unless (form-offset m 1)
1264     (editor-error "Not enough top level forms."))
1265     (when (blank-after-p m) (line-offset m 1 0))
1266     (move-mark point m)))))))
1267    
1268     (defcommand "Forward List" (p)
1269     "Skip over the next Lisp list.
1270     With argument, skips the next p lists."
1271     "Skip over the next Lisp list."
1272     (let ((point (current-point))
1273     (count (or p 1)))
1274     (pre-command-parse-check point)
1275     (unless (list-offset point count) (editor-error))))
1276    
1277     (defcommand "Backward List" (p)
1278     "Skip over the previous Lisp list.
1279     With argument, skips the previous p lists."
1280     "Skip over the previous Lisp list."
1281     (let ((point (current-point))
1282     (count (- (or p 1))))
1283     (pre-command-parse-check point)
1284     (unless (list-offset point count) (editor-error))))
1285    
1286     (defcommand "Forward Form" (p)
1287     "Skip over the next Form.
1288     With argument, skips the next p Forms."
1289     "Skip over the next Form."
1290     (let ((point (current-point))
1291     (count (or p 1)))
1292     (pre-command-parse-check point)
1293     (unless (form-offset point count) (editor-error))))
1294    
1295     (defcommand "Backward Form" (p)
1296     "Skip over the previous Form.
1297     With argument, skips the previous p Forms."
1298     "Skip over the previous Form."
1299     (let ((point (current-point))
1300     (count (- (or p 1))))
1301     (pre-command-parse-check point)
1302     (unless (form-offset point count) (editor-error))))
1303    
1304     (defcommand "Mark Form" (p)
1305     "Set the mark at the end of the next Form.
1306     With a positive argument, set the mark after the following p
1307     Forms. With a negative argument, set the mark before
1308     the preceding -p Forms."
1309     "Set the mark at the end of the next Form."
1310     (with-mark ((m (current-point)))
1311     (pre-command-parse-check m)
1312     (let ((count (or p 1))
1313     (mark (push-buffer-mark (copy-mark m) t)))
1314     (if (form-offset m count)
1315     (move-mark mark m)
1316     (editor-error)))))
1317    
1318     (defcommand "Mark Defun" (p)
1319     "Puts the region around the next or containing top-level form.
1320     The point is left before the form and the mark is placed immediately
1321     after it."
1322     "Puts the region around the next or containing top-level form."
1323     (declare (ignore p))
1324     (let ((point (current-point)))
1325     (pre-command-parse-check point)
1326     (with-mark ((start point)
1327     (end point))
1328     (cond ((not (mark-top-level-form start end))
1329     (editor-error "No current or next top level form."))
1330     (t
1331     (move-mark point start)
1332     (move-mark (push-buffer-mark (copy-mark point) t) end))))))
1333    
1334     (defcommand "Forward Kill Form" (p)
1335     "Kill the next Form.
1336     With a positive argument, kills the next p Forms.
1337     Kills backward with a negative argument."
1338     "Kill the next Form."
1339     (with-mark ((m1 (current-point))
1340     (m2 (current-point)))
1341     (pre-command-parse-check m1)
1342     (let ((count (or p 1)))
1343     (unless (form-offset m1 count) (editor-error))
1344     (if (minusp count)
1345     (kill-region (region m1 m2) :kill-backward)
1346     (kill-region (region m2 m1) :kill-forward)))))
1347    
1348     (defcommand "Backward Kill Form" (p)
1349     "Kill the previous Form.
1350     With a positive argument, kills the previous p Forms.
1351     Kills forward with a negative argument."
1352     "Kill the previous Form."
1353     (forward-kill-form-command (- (or p 1))))
1354    
1355 ram 1.1.1.2 (defcommand "Extract Form" (p)
1356     "Replace the current containing list with the next form. The entire affected
1357     area is pushed onto the kill ring. If an argument is supplied, that many
1358     upward levels of list nesting is replaced by the next form."
1359     "Replace the current containing list with the next form. The entire affected
1360     area is pushed onto the kill ring. If an argument is supplied, that many
1361     upward levels of list nesting is replaced by the next form."
1362     (let ((point (current-point)))
1363     (pre-command-parse-check point)
1364     (with-mark ((form-start point :right-inserting)
1365     (form-end point))
1366     (unless (form-offset form-end 1) (editor-error))
1367     (form-offset (move-mark form-start form-end) -1)
1368     (with-mark ((containing-start form-start :left-inserting)
1369     (containing-end form-end :left-inserting))
1370     (dotimes (i (or p 1))
1371     (unless (and (forward-up-list containing-end)
1372     (backward-up-list containing-start))
1373     (editor-error)))
1374     (let ((r (copy-region (region form-start form-end))))
1375     (ring-push (delete-and-save-region
1376     (region containing-start containing-end))
1377     *kill-ring*)
1378     (ninsert-region point r)
1379     (move-mark point form-start))))))
1380    
1381 ram 1.1 (defcommand "Extract List" (p)
1382     "Extract the current list.
1383     The current list replaces the surrounding list. The entire affected
1384     area is pushed on the kill-ring. With prefix argument, remove that
1385     many surrounding lists."
1386     "Replace the P containing lists with the current one."
1387     (let ((point (current-point)))
1388     (pre-command-parse-check point)
1389     (with-mark ((lstart point :right-inserting)
1390     (lend point))
1391     (if (eq (character-attribute :lisp-syntax (next-character lstart))
1392     :open-paren)
1393     (mark-after lend)
1394     (unless (backward-up-list lstart) (editor-error)))
1395     (unless (forward-up-list lend) (editor-error))
1396     (with-mark ((rstart lstart)
1397     (rend lend))
1398     (dotimes (i (or p 1))
1399     (unless (and (forward-up-list rend) (backward-up-list rstart))
1400     (editor-error)))
1401     (let ((r (copy-region (region lstart lend))))
1402     (ring-push (delete-and-save-region (region rstart rend))
1403     *kill-ring*)
1404     (ninsert-region point r)
1405     (move-mark point lstart))))))
1406    
1407     (defcommand "Transpose Forms" (p)
1408     "Transpose Forms immediately preceding and following the point.
1409     With a zero argument, tranposes the Forms at the point and the mark.
1410     With a positive argument, transposes the Form preceding the point
1411     with the p-th one following it. With a negative argument, transposes the
1412     Form following the point with the p-th one preceding it."
1413     "Transpose Forms immediately preceding and following the point."
1414     (let ((point (current-point))
1415     (count (or p 1)))
1416     (pre-command-parse-check point)
1417     (if (zerop count)
1418     (let ((mark (current-mark)))
1419     (with-mark ((s1 mark :left-inserting)
1420     (s2 point :left-inserting))
1421     (scan-char s1 :whitespace nil)
1422     (scan-char s2 :whitespace nil)
1423     (with-mark ((e1 s1 :right-inserting)
1424     (e2 s2 :right-inserting))
1425     (unless (form-offset e1 1) (editor-error))
1426     (unless (form-offset e2 1) (editor-error))
1427     (ninsert-region s1 (delete-and-save-region (region s2 e2)))
1428     (ninsert-region s2 (delete-and-save-region (region s1 e1))))))
1429     (let ((fcount (if (plusp count) count 1))
1430     (bcount (if (plusp count) 1 count)))
1431     (with-mark ((s1 point :left-inserting)
1432     (e2 point :right-inserting))
1433     (dotimes (i bcount)
1434     (unless (form-offset s1 -1) (editor-error)))
1435     (dotimes (i fcount)
1436     (unless (form-offset e2 1) (editor-error)))
1437     (with-mark ((e1 s1 :right-inserting)
1438     (s2 e2 :left-inserting))
1439     (unless (form-offset e1 1) (editor-error))
1440     (unless (form-offset s2 -1) (editor-error))
1441     (ninsert-region s1 (delete-and-save-region (region s2 e2)))
1442     (ninsert-region s2 (delete-and-save-region (region s1 e1)))
1443     (move-mark point s2)))))))
1444    
1445    
1446     (defcommand "Insert ()" (p)
1447     "Insert a pair of parentheses ().
1448     With positive argument, puts parentheses around the next p
1449     Forms. The point is positioned after the open parenthesis."
1450     "Insert a pair of parentheses ()."
1451     (let ((point (current-point))
1452     (count (or p 0)))
1453     (pre-command-parse-check point)
1454     (cond ((not (minusp count))
1455     (insert-character point #\()
1456     (with-mark ((tmark point))
1457     (unless (form-offset tmark count) (editor-error))
1458     (cond ((mark= tmark point)
1459     (insert-character point #\))
1460     (mark-before point))
1461     (t (insert-character tmark #\))))))
1462     (t (editor-error)))))
1463    
1464    
1465     (defcommand "Move Over )" (p)
1466     "Move past the next close parenthesis, and start a new line.
1467     Any indentation preceding the preceding the parenthesis is deleted,
1468     and the new line is indented."
1469     "Move past the next close parenthesis, and start a new line."
1470     (declare (ignore p))
1471     (let ((point (current-point)))
1472     (pre-command-parse-check point)
1473 wlott 1.1.1.11 (with-mark ((m point :left-inserting))
1474 ram 1.1 (cond ((scan-char m :lisp-syntax :close-paren)
1475     (delete-horizontal-space m)
1476     (mark-after m)
1477     (move-mark point m)
1478 wlott 1.1.1.11 (delete-mark m)
1479 ram 1.1 (indent-new-line-command 1))
1480 wlott 1.1.1.11 (t
1481     (delete-mark m)
1482     (editor-error))))))
1483 ram 1.1
1484    
1485     (defcommand "Forward Up List" (p)
1486     "Move forward past a one containing )."
1487     "Move forward past a one containing )."
1488     (let ((point (current-point))
1489     (count (or p 1)))
1490     (pre-command-parse-check point)
1491     (if (minusp count)
1492     (backward-up-list-command (- count))
1493     (with-mark ((m point))
1494     (dotimes (i count (move-mark point m))
1495     (unless (forward-up-list m) (editor-error)))))))
1496    
1497    
1498     (defcommand "Backward Up List" (p)
1499     "Move backward past a one containing (."
1500     "Move backward past a one containing (."
1501     (let ((point (current-point))
1502     (count (or p 1)))
1503     (pre-command-parse-check point)
1504     (if (minusp count)
1505     (forward-up-list-command (- count))
1506     (with-mark ((m point))
1507     (dotimes (i count (move-mark point m))
1508     (unless (backward-up-list m) (editor-error)))))))
1509    
1510    
1511     (defcommand "Down List" (p)
1512     "Move down a level in list structure.
1513     With argument, moves down p levels."
1514     "Move down a level in list structure."
1515     (let ((point (current-point))
1516     (count (or p 1)))
1517     (pre-command-parse-check point)
1518     (with-mark ((m point))
1519     (dotimes (i count (move-mark point m))
1520     (unless (and (scan-char m :lisp-syntax :open-paren)
1521     (mark-after m))
1522     (editor-error))))))
1523    
1524    
1525    
1526 chiles 1.1.1.10 ;;;; Filling Lisp comments, strings, and indented text.
1527    
1528     (defhvar "Fill Lisp Comment Paragraph Confirm"
1529     "This determines whether \"Fill Lisp Comment Paragraph\" will prompt for
1530     confirmation to fill contiguous lines with the same initial whitespace when
1531     it is invoked outside of a comment or string."
1532     :value t)
1533    
1534     (defcommand "Fill Lisp Comment Paragraph" (p)
1535     "This fills a flushleft or indented Lisp comment.
1536     This also fills Lisp string literals using the proper indentation as a
1537     filling prefix. When invoked outside of a comment or string, this tries
1538     to fill all contiguous lines beginning with the same initial, non-empty
1539     blankspace. When filling a comment, the current line is used to determine a
1540     fill prefix by taking all the initial whitespace on the line, the semicolons,
1541     and any whitespace following the semicolons."
1542     "Fills a flushleft or indented Lisp comment."
1543     (declare (ignore p))
1544     (let ((point (current-point)))
1545     (pre-command-parse-check point)
1546     (with-mark ((start point)
1547     (end point)
1548     (m point))
1549     (let ((commentp (fill-lisp-comment-paragraph-prefix start end)))
1550     (cond (commentp
1551     (fill-lisp-comment-or-indented-text start end))
1552     ((and (not (valid-spot m nil))
1553     (form-offset m -1)
1554     (eq (character-attribute :lisp-syntax (next-character m))
1555     :string-quote))
1556     (fill-lisp-string m))
1557     ((or (not (value fill-lisp-comment-paragraph-confirm))
1558     (prompt-for-y-or-n
1559     :prompt '("Not in a comment or string. Fill contiguous ~
1560     lines with the same initial whitespace? ")))
1561     (fill-lisp-comment-or-indented-text start end)))))))
1562    
1563     ;;; FILL-LISP-STRING -- Internal.
1564     ;;;
1565     ;;; This fills the Lisp string containing mark as if it had been entered using
1566     ;;; Hemlock's Lisp string indentation, "Indent Function" for "Lisp" mode. This
1567     ;;; assumes the area around mark has already been PRE-COMMAND-PARSE-CHECK'ed,
1568     ;;; and it ensures the string ends before doing any filling. This function
1569     ;;; is undo'able.
1570     ;;;
1571     (defun fill-lisp-string (mark)
1572     (with-mark ((end mark))
1573     (unless (form-offset end 1)
1574     (editor-error "Attempted to fill Lisp string, but it doesn't end?"))
1575     (let* ((mark (copy-mark mark :left-inserting))
1576     (end (copy-mark end :left-inserting))
1577     (string-region (region mark end))
1578     (undo-region (copy-region string-region))
1579     (hack (make-empty-region)))
1580     ;; Generate prefix.
1581     (funcall (value indent-with-tabs)
1582     (region-end hack) (1+ (mark-column mark)))
1583     ;; Skip opening double quote and fill string starting on its own line.
1584     (mark-after mark)
1585     (insert-character mark #\newline)
1586     (line-start mark)
1587     (setf (mark-kind mark) :right-inserting)
1588     (fill-region string-region (region-to-string hack))
1589     ;; Clean up inserted prefix on first line, delete inserted newline, and
1590     ;; move before the double quote for undo.
1591     (with-mark ((text mark :left-inserting))
1592     (find-attribute text :whitespace #'zerop)
1593     (delete-region (region mark text)))
1594     (delete-characters mark -1)
1595     (mark-before mark)
1596     ;; Save undo.
1597     (make-region-undo :twiddle "Fill Lisp Comment Paragraph"
1598     string-region undo-region))))
1599    
1600     ;;; FILL-LISP-COMMENT-OR-INDENTED-TEXT -- Internal.
1601     ;;;
1602     ;;; This fills all contiguous lines around start and end containing fill prefix
1603     ;;; designated by the region between start and end. These marks can only be
1604     ;;; equal when there is no comment and no initial whitespace. This is a bad
1605     ;;; situation since this function in that situation would fill the entire
1606     ;;; buffer into one paragraph. This function is undo'able.
1607     ;;;
1608     (defun fill-lisp-comment-or-indented-text (start end)
1609     (when (mark= start end)
1610     (editor-error "This command only fills Lisp comments, strings, or ~
1611     indented text, but this line is flushleft."))
1612     ;;
1613     ;; Find comment block.
1614     (let* ((prefix (region-to-string (region start end)))
1615     (length (length prefix)))
1616     (declare (simple-string prefix))
1617     (flet ((frob (mark direction)
1618     (loop
1619     (let* ((line (line-string (mark-line mark)))
1620     (line-len (length line)))
1621     (declare (simple-string line))
1622     (unless (string= line prefix :end1 (min line-len length))
1623     (when (= direction -1)
1624     (unless (same-line-p mark end) (line-offset mark 1 0)))
1625     (return)))
1626     (unless (line-offset mark direction 0)
1627     (when (= direction 1) (line-end mark))
1628     (return)))))
1629     (frob start -1)
1630     (frob end 1))
1631     ;;
1632     ;; Do it undoable.
1633     (let* ((start1 (copy-mark start :right-inserting))
1634     (end2 (copy-mark end :left-inserting))
1635     (region (region start1 end2))
1636     (undo-region (copy-region region)))
1637     (fill-region region prefix)
1638     (make-region-undo :twiddle "Fill Lisp Comment Paragraph"
1639     region undo-region))))
1640    
1641     ;;; FILL-LISP-COMMENT-PARAGRAPH-PREFIX -- Internal.
1642     ;;;
1643     ;;; This sets start and end around the prefix to be used for filling. We
1644     ;;; assume we are dealing with a comment. If there is no ";", then we try to
1645     ;;; find some initial whitespace. If there is a ";", we make sure the line is
1646     ;;; blank before it to eliminate ";"'s in the middle of a line of text.
1647     ;;; Finally, if we really have a comment instead of some indented text, we skip
1648     ;;; the ";"'s and any immediately following whitespace. We allow initial
1649     ;;; whitespace, so we can fill strings with the same command.
1650     ;;;
1651     (defun fill-lisp-comment-paragraph-prefix (start end)
1652     (line-start start)
1653     (let ((commentp t)) ; Assumes there's a comment.
1654     (unless (to-line-comment (line-start end) ";")
1655     (find-attribute end :whitespace #'zerop)
1656     #|(when (start-line-p end)
1657     (editor-error "No comment on line, and no initial whitespace."))|#
1658     (setf commentp nil))
1659     (when commentp
1660     (unless (blank-before-p end)
1661     (find-attribute (line-start end) :whitespace #'zerop)
1662     #|(when (start-line-p end)
1663     (editor-error "Semicolon preceded by unindented text."))|#
1664     (setf commentp nil)))
1665     (when commentp
1666     (find-attribute end :lisp-syntax #'(lambda (x) (not (eq x :comment))))
1667     (find-attribute end :whitespace #'zerop))
1668     commentp))
1669    
1670    
1671    
1672     ;;;; "Lisp" mode.
1673 ram 1.1
1674     (defcommand "LISP Mode" (p)
1675     "Put current buffer in LISP mode."
1676     "Put current buffer in LISP mode."
1677     (declare (ignore p))
1678     (setf (buffer-major-mode (current-buffer)) "LISP"))
1679    
1680    
1681     (defmode "Lisp" :major-p t :setup-function 'setup-lisp-mode)
1682    
1683     (defun setup-lisp-mode (buffer)
1684     (unless (hemlock-bound-p 'current-package :buffer buffer)
1685     (defhvar "Current Package"
1686     "The package used for evaluation of Lisp in this buffer."
1687     :buffer buffer
1688     :value "USER")))
1689    
1690    
1691    
1692     ;;;; Matching parenthesis display.
1693    
1694     (defhvar "Paren Pause Period"
1695     "This is how long commands that deal with \"brackets\" shows the cursor at
1696     the matching \"bracket\" for this number of seconds."
1697     :value 0.5)
1698    
1699     (defcommand "Lisp Insert )" (p)
1700     "Inserts a \")\" and briefly positions the cursor at the matching \"(\"."
1701     "Inserts a \")\" and briefly positions the cursor at the matching \"(\"."
1702     (declare (ignore p))
1703     (let ((point (current-point)))
1704     (insert-character point #\))
1705     (pre-command-parse-check point)
1706     (when (valid-spot point nil)
1707     (with-mark ((m point))
1708     (if (list-offset m -1)
1709     (let ((pause (value paren-pause-period))
1710     (win (current-window)))
1711     (if pause
1712     (unless (show-mark m win pause)
1713     (clear-echo-area)
1714     (message "~A" (line-string (mark-line m))))
1715     (unless (displayed-p m (current-window))
1716     (clear-echo-area)
1717     (message "~A" (line-string (mark-line m))))))
1718     (editor-error))))))
1719    
1720     ;;; Since we use paren highlighting in Lisp mode, we do not want paren
1721     ;;; flashing too.
1722     ;;;
1723     (defhvar "Paren Pause Period"
1724     "This is how long commands that deal with \"brackets\" shows the cursor at
1725     the matching \"bracket\" for this number of seconds."
1726     :value nil
1727     :mode "Lisp")
1728     ;;;
1729     (defhvar "Highlight Open Parens"
1730     "When non-nil, causes open parens to be displayed in a different font when
1731     the cursor is directly to the right of the corresponding close paren."
1732     :value t
1733     :mode "Lisp")
1734 wlott 1.1.1.13
1735    
1736     (defhvar "Open Paren Finder Function"
1737     "Should be a function that takes a mark for input and returns either NIL
1738     if the mark is not after a close paren, or two (temporary) marks
1739     surrounding the corresponding open paren."
1740     :mode "Lisp"
1741     :value 'lisp-open-paren-finder-function)
1742    
1743     (defun lisp-open-paren-finder-function (mark)
1744     (when (eq (character-attribute :lisp-syntax (previous-character mark))
1745     :close-paren)
1746     (with-mark ((mark mark))
1747     (pre-command-parse-check mark)
1748     (if (not (and (valid-spot mark nil) (list-offset mark -1)))
1749     (values nil nil)
1750     (values mark (mark-after (copy-mark mark)))))))
1751 ram 1.1
1752    
1753    
1754     ;;;; Some mode variables to coordinate with other stuff.
1755    
1756     (defhvar "Auto Fill Space Indent"
1757     "When non-nil, uses \"Indent New Comment Line\" to break lines instead of
1758     \"New Line\"."
1759     :mode "Lisp" :value t)
1760    
1761     (defhvar "Comment Start"
1762     "String that indicates the start of a comment."
1763     :mode "Lisp" :value ";")
1764    
1765     (defhvar "Comment Begin"
1766     "String that is inserted to begin a comment."
1767     :mode "Lisp" :value "; ")
1768    
1769     (defhvar "Indent Function"
1770     "Indentation function which is invoked by \"Indent\" command.
1771     It must take one argument that is the prefix argument."
1772     :value 'indent-for-lisp
1773     :mode "Lisp")

  ViewVC Help
Powered by ViewVC 1.1.5