*** empty log message ***
[emacs.git] / lisp / newcomment.el
blob9ddcda42769cc40e30d8700ea95510e8a082c0ff
1 ;;; newcomment.el --- (un)comment regions of buffers
3 ;; Copyright (C) 1999, 2000 Free Software Foundation Inc.
5 ;; Author: code extracted from Emacs-20's simple.el
6 ;; Maintainer: Stefan Monnier <monnier@cs.yale.edu>
7 ;; Keywords: comment uncomment
8 ;; Revision: $Id: newcomment.el,v 1.30 2001/02/22 01:47:40 monnier Exp $
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
27 ;;; Commentary:
29 ;; A replacement for simple.el's comment-related functions.
31 ;;; Bugs:
33 ;; - single-char nestable comment-start can only do the "\\s<+" stuff
34 ;; if the corresponding closing marker happens to be right.
35 ;; - comment-box in TeXinfo generate bogus comments @ccccc@
36 ;; - uncomment-region with a numeric argument can render multichar
37 ;; comment markers invalid.
38 ;; - comment-indent or comment-region when called inside a comment
39 ;; will happily break the surrounding comment.
40 ;; - comment-quote-nested will not (un)quote properly all nested comment
41 ;; markers if there are more than just comment-start and comment-end.
42 ;; For example, in Pascal where {...*) and (*...} are possible.
44 ;;; Todo:
46 ;; - try to align tail comments
47 ;; - check what c-comment-line-break-function has to say
48 ;; - spill auto-fill of comments onto the end of the next line
49 ;; - uncomment-region with a consp (for blocks) or somehow make the
50 ;; deletion of continuation markers less dangerous
51 ;; - drop block-comment-<foo> unless it's really used
52 ;; - uncomment-region on a subpart of a comment
53 ;; - support gnu-style "multi-line with space in continue"
54 ;; - somehow allow comment-dwim to use the region even if transient-mark-mode
55 ;; is not turned on.
57 ;; - when auto-filling a comment, try to move the comment to the left
58 ;; rather than break it (if possible).
59 ;; - sometimes default the comment-column to the same
60 ;; one used on the preceding line(s).
62 ;;; Code:
64 ;;;###autoload
65 (defalias 'indent-for-comment 'comment-indent)
66 ;;;###autoload
67 (defalias 'set-comment-column 'comment-set-column)
68 ;;;###autoload
69 (defalias 'kill-comment 'comment-kill)
70 ;;;###autoload
71 (defalias 'indent-new-comment-line 'comment-indent-new-line)
73 ;;;###autoload
74 (defgroup comment nil
75 "Indenting and filling of comments."
76 :prefix "comment-"
77 :version "21.1"
78 :group 'fill)
80 (defvar comment-use-syntax 'undecided
81 "Non-nil if syntax-tables can be used instead of regexps.
82 Can also be `undecided' which means that a somewhat expensive test will
83 be used to try to determine whether syntax-tables should be trusted
84 to understand comments or not in the given buffer.
85 Major modes should set this variable.")
87 ;;;###autoload
88 (defcustom comment-column 32
89 "*Column to indent right-margin comments to.
90 Setting this variable automatically makes it local to the current buffer.
91 Each mode establishes a different default value for this variable; you
92 can set the value for a particular mode using that mode's hook."
93 :type 'integer
94 :group 'comment)
95 (make-variable-buffer-local 'comment-column)
97 ;;;###autoload
98 (defvar comment-start nil
99 "*String to insert to start a new comment, or nil if no comment syntax.")
101 ;;;###autoload
102 (defvar comment-start-skip nil
103 "*Regexp to match the start of a comment plus everything up to its body.
104 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
105 at the place matched by the close of the first pair.")
107 ;;;###autoload
108 (defvar comment-end-skip nil
109 "Regexp to match the end of a comment plus everything up to its body.")
111 ;;;###autoload
112 (defvar comment-end ""
113 "*String to insert to end a new comment.
114 Should be an empty string if comments are terminated by end-of-line.")
116 ;;;###autoload
117 (defvar comment-indent-function 'comment-indent-default
118 "Function to compute desired indentation for a comment.
119 This function is called with no args with point at the beginning of
120 the comment's starting delimiter and should return either the desired
121 column indentation or nil.
122 If nil is returned, indentation is delegated to `indent-according-to-mode'.")
124 (defvar block-comment-start nil)
125 (defvar block-comment-end nil)
127 (defvar comment-quote-nested t
128 "Non-nil if nested comments should be quoted.
129 This should be locally set by each major mode if needed.")
131 (defvar comment-continue nil
132 "Continuation string to insert for multiline comments.
133 This string will be added at the beginning of each line except the very
134 first one when commenting a region with a commenting style that allows
135 comments to span several lines.
136 It should generally have the same length as `comment-start' in order to
137 preserve indentation.
138 If it is nil a value will be automatically derived from `comment-start'
139 by replacing its first character with a space.")
141 (defvar comment-add 0
142 "How many more comment chars should be inserted by `comment-region'.
143 This determines the default value of the numeric argument of `comment-region'.
144 This should generally stay 0, except for a few modes like Lisp where
145 it can be convenient to set it to 1 so that regions are commented with
146 two semi-colons.")
148 (defconst comment-styles
149 '((plain . (nil nil nil nil))
150 (indent . (nil nil nil t))
151 (aligned . (nil t nil t))
152 (multi-line . (t nil nil t))
153 (extra-line . (t nil t t))
154 (box . (nil t t t))
155 (box-multi . (t t t t)))
156 "Possible comment styles of the form (STYLE . (MULTI ALIGN EXTRA INDENT)).
157 STYLE should be a mnemonic symbol.
158 MULTI specifies that comments are allowed to span multiple lines.
159 ALIGN specifies that the `comment-end' markers should be aligned.
160 EXTRA specifies that an extra line should be used before and after the
161 region to comment (to put the `comment-end' and `comment-start').
162 INDENT specifies that the `comment-start' markers should not be put at the
163 left margin but at the current indentation of the region to comment.")
165 ;;;###autoload
166 (defcustom comment-style 'plain
167 "*Style to be used for `comment-region'.
168 See `comment-styles' for a list of available styles."
169 :group 'comment
170 :type (if (boundp 'comment-styles)
171 `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles))
172 'symbol))
174 ;;;###autoload
175 (defcustom comment-padding " "
176 "Padding string that `comment-region' puts between comment chars and text.
177 Can also be an integer which will be automatically turned into a string
178 of the corresponding number of spaces.
180 Extra spacing between the comment characters and the comment text
181 makes the comment easier to read. Default is 1. nil means 0.")
183 ;;;###autoload
184 (defcustom comment-multi-line nil
185 "*Non-nil means \\[comment-indent-new-line] continues comments, with no new terminator or starter.
186 This is obsolete because you might as well use \\[newline-and-indent]."
187 :type 'boolean
188 :group 'comment)
190 ;;;;
191 ;;;; Helpers
192 ;;;;
194 (defun comment-string-strip (str beforep afterp)
195 "Strip STR of any leading (if BEFOREP) and/or trailing (if AFTERP) space."
196 (string-match (concat "\\`" (if beforep "\\s-*")
197 "\\(.*?\\)" (if afterp "\\s-*\n?")
198 "\\'") str)
199 (match-string 1 str))
201 (defun comment-string-reverse (s)
202 "Return the mirror image of string S, without any trailing space."
203 (comment-string-strip (concat (nreverse (string-to-list s))) nil t))
205 (defun comment-normalize-vars (&optional noerror)
206 (if (not comment-start) (or noerror (error "No comment syntax is defined"))
207 ;; comment-use-syntax
208 (when (eq comment-use-syntax 'undecided)
209 (set (make-local-variable 'comment-use-syntax)
210 (let ((st (syntax-table))
211 (cs comment-start)
212 (ce (if (string= "" comment-end) "\n" comment-end)))
213 ;; Try to skip over a comment using forward-comment
214 ;; to see if the syntax tables properly recognize it.
215 (with-temp-buffer
216 (set-syntax-table st)
217 (insert cs " hello " ce)
218 (goto-char (point-min))
219 (and (forward-comment 1) (eobp))))))
220 ;; comment-padding
221 (when (integerp comment-padding)
222 (setq comment-padding (make-string comment-padding ? )))
223 ;; comment markers
224 ;;(setq comment-start (comment-string-strip comment-start t nil))
225 ;;(setq comment-end (comment-string-strip comment-end nil t))
226 ;; comment-continue
227 (unless (or comment-continue (string= comment-end ""))
228 (set (make-local-variable 'comment-continue)
229 (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
230 (substring comment-start 1))))
231 ;; comment-skip regexps
232 (unless comment-start-skip
233 (set (make-local-variable 'comment-start-skip)
234 (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
235 (regexp-quote (comment-string-strip comment-start t t))
236 ;; Let's not allow any \s- but only [ \t] since \n
237 ;; might be both a comment-end marker and \s-.
238 "+\\)[ \t]*")))
239 (unless comment-end-skip
240 (let ((ce (if (string= "" comment-end) "\n"
241 (comment-string-strip comment-end t t))))
242 (set (make-local-variable 'comment-end-skip)
243 (concat "\\s-*\\(\\s>" (if comment-quote-nested "" "+")
244 "\\|" (regexp-quote (substring ce 0 1))
245 (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
246 (regexp-quote (substring ce 1))
247 "\\)"))))))
249 (defun comment-quote-re (str unp)
250 (concat (regexp-quote (substring str 0 1))
251 "\\\\" (if unp "+" "*")
252 (regexp-quote (substring str 1))))
254 (defun comment-quote-nested (cs ce unp)
255 "Quote or unquote nested comments.
256 If UNP is non-nil, unquote nested comment markers."
257 (setq cs (comment-string-strip cs t t))
258 (setq ce (comment-string-strip ce t t))
259 (when (and comment-quote-nested (> (length ce) 0))
260 (let ((re (concat (comment-quote-re ce unp)
261 "\\|" (comment-quote-re cs unp))))
262 (goto-char (point-min))
263 (while (re-search-forward re nil t)
264 (goto-char (match-beginning 0))
265 (forward-char 1)
266 (if unp (delete-char 1) (insert "\\"))
267 (when (= (length ce) 1)
268 ;; If the comment-end is a single char, adding a \ after that
269 ;; "first" char won't deactivate it, so we turn such a CE
270 ;; into !CS. I.e. for pascal, we turn } into !{
271 (if (not unp)
272 (when (string= (match-string 0) ce)
273 (replace-match (concat "!" cs) t t))
274 (when (and (< (point-min) (match-beginning 0))
275 (string= (buffer-substring (1- (match-beginning 0))
276 (1- (match-end 0)))
277 (concat "!" cs)))
278 (backward-char 2)
279 (delete-char (- (match-end 0) (match-beginning 0)))
280 (insert ce))))))))
282 ;;;;
283 ;;;; Navigation
284 ;;;;
286 (defun comment-search-forward (limit &optional noerror)
287 "Find a comment start between point and LIMIT.
288 Moves point to inside the comment and returns the position of the
289 comment-starter. If no comment is found, moves point to LIMIT
290 and raises an error or returns nil of NOERROR is non-nil."
291 (if (not comment-use-syntax)
292 (if (re-search-forward comment-start-skip limit noerror)
293 (or (match-end 1) (match-beginning 0))
294 (goto-char limit)
295 (unless noerror (error "No comment")))
296 (let* ((pt (point))
297 ;; Assume (at first) that pt is outside of any string.
298 (s (parse-partial-sexp pt (or limit (point-max)) nil nil nil t)))
299 (when (and (nth 8 s) (nth 3 s))
300 ;; The search ended inside a string. Try to see if it
301 ;; works better when we assume that pt is inside a string.
302 (setq s (parse-partial-sexp
303 pt (or limit (point-max)) nil nil
304 (list nil nil nil (nth 3 s) nil nil nil nil)
305 t)))
306 (if (not (and (nth 8 s) (not (nth 3 s))))
307 (unless noerror (error "No comment"))
308 ;; We found the comment.
309 (let ((pos (point))
310 (start (nth 8 s))
311 (bol (line-beginning-position))
312 (end nil))
313 (while (and (null end) (>= (point) bol))
314 (if (looking-at comment-start-skip)
315 (setq end (min (or limit (point-max)) (match-end 0)))
316 (backward-char)))
317 (goto-char (or end pos))
318 start)))))
320 (defun comment-search-backward (&optional limit noerror)
321 "Find a comment start between LIMIT and point.
322 Moves point to inside the comment and returns the position of the
323 comment-starter. If no comment is found, moves point to LIMIT
324 and raises an error or returns nil of NOERROR is non-nil."
325 ;; FIXME: If a comment-start appears inside a comment, we may erroneously
326 ;; stop there. This can be rather bad in general, but since
327 ;; comment-search-backward is only used to find the comment-column (in
328 ;; comment-set-column) and to find the comment-start string (via
329 ;; comment-beginning) in indent-new-comment-line, it should be harmless.
330 (if (not (re-search-backward comment-start-skip limit t))
331 (unless noerror (error "No comment"))
332 (beginning-of-line)
333 (let* ((end (match-end 0))
334 (cs (comment-search-forward end t))
335 (pt (point)))
336 (if (not cs)
337 (progn (beginning-of-line)
338 (comment-search-backward limit noerror))
339 (while (progn (goto-char cs)
340 (comment-forward)
341 (and (< (point) end)
342 (setq cs (comment-search-forward end t))))
343 (setq pt (point)))
344 (goto-char pt)
345 cs))))
347 (defun comment-beginning ()
348 "Find the beginning of the enclosing comment.
349 Returns nil if not inside a comment, else moves point and returns
350 the same as `comment-search-forward'."
351 ;; HACK ATTACK!
352 ;; We should really test `in-string-p' but that can be expensive.
353 (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
354 (let ((pt (point))
355 (cs (comment-search-backward nil t)))
356 (when cs
357 (if (save-excursion
358 (goto-char cs)
359 (if (comment-forward 1) (> (point) pt) (eobp)))
361 (goto-char pt)
362 nil)))))
364 (defun comment-forward (&optional n)
365 "Skip forward over N comments.
366 Just like `forward-comment' but only for positive N
367 and can use regexps instead of syntax."
368 (setq n (or n 1))
369 (if (< n 0) (error "No comment-backward")
370 (if comment-use-syntax (forward-comment n)
371 (while (> n 0)
372 (skip-syntax-forward " ")
373 (setq n
374 (if (and (looking-at comment-start-skip)
375 (goto-char (match-end 0))
376 (re-search-forward comment-end-skip nil 'move))
377 (1- n) -1)))
378 (= n 0))))
380 (defun comment-enter-backward ()
381 "Move from the end of a comment to the end of its content.
382 Point is assumed to be just at the end of a comment."
383 (if (bolp)
384 ;; comment-end = ""
385 (progn (backward-char) (skip-syntax-backward " "))
386 (let ((end (point)))
387 (beginning-of-line)
388 (save-restriction
389 (narrow-to-region (point) end)
390 (if (re-search-forward (concat comment-end-skip "\\'") nil t)
391 (goto-char (match-beginning 0))
392 ;; comment-end-skip not found probably because it was not set right.
393 ;; Since \\s> should catch the single-char case, we'll blindly
394 ;; assume we're at the end of a two-char comment-end.
395 (goto-char (point-max))
396 (backward-char 2)
397 (skip-chars-backward (string (char-after)))
398 (skip-syntax-backward " "))))))
400 ;;;;
401 ;;;; Commands
402 ;;;;
404 ;;;###autoload
405 (defun comment-indent-default ()
406 "Default for `comment-indent-function'."
407 (if (and (looking-at "\\s<\\s<\\(\\s<\\)?")
408 (or (match-end 1) (/= (current-column) (current-indentation))))
410 (when (or (/= (current-column) (current-indentation))
411 (and (> comment-add 0) (looking-at "\\s<\\S<")))
412 comment-column)))
414 ;;;###autoload
415 (defun comment-indent (&optional continue)
416 "Indent this line's comment to comment column, or insert an empty comment.
417 If CONTINUE is non-nil, use the `comment-continuation' markers if any."
418 (interactive "*")
419 (comment-normalize-vars)
420 (let* ((empty (save-excursion (beginning-of-line)
421 (looking-at "[ \t]*$")))
422 (starter (or (and continue comment-continue)
423 (and empty block-comment-start) comment-start))
424 (ender (or (and continue comment-continue "")
425 (and empty block-comment-end) comment-end)))
426 (unless starter (error "No comment syntax defined"))
427 (beginning-of-line)
428 (let* ((eolpos (line-end-position))
429 (begpos (comment-search-forward eolpos t))
430 cpos indent)
431 ;; An existing comment?
432 (if begpos (setq cpos (point-marker))
433 ;; If none, insert one.
434 (save-excursion
435 ;; Some comment-indent-function insist on not moving comments that
436 ;; are in column 0, so we insert a space to avoid this special case
437 (insert " ")
438 (setq begpos (point))
439 (insert starter)
440 (setq cpos (point-marker))
441 (insert ender)))
442 (goto-char begpos)
443 ;; Compute desired indent.
444 (setq indent (save-excursion (funcall comment-indent-function)))
445 (if (not indent)
446 ;; comment-indent-function refuses delegates to indent.
447 (indent-according-to-mode)
448 ;; Avoid moving comments past the fill-column.
449 (setq indent
450 (min indent
451 (+ (current-column)
452 (- fill-column
453 (save-excursion (end-of-line) (current-column))))))
454 (if (= (current-column) indent)
455 (goto-char begpos)
456 ;; If that's different from current, change it.
457 (skip-chars-backward " \t")
458 (delete-region (point) begpos)
459 (indent-to (if (bolp) indent
460 (max indent (1+ (current-column)))))))
461 (goto-char cpos)
462 (set-marker cpos nil))))
464 ;;;###autoload
465 (defun comment-set-column (arg)
466 "Set the comment column based on point.
467 With no ARG, set the comment column to the current column.
468 With just minus as arg, kill any comment on this line.
469 With any other arg, set comment column to indentation of the previous comment
470 and then align or create a comment on this line at that column."
471 (interactive "P")
472 (cond
473 ((eq arg '-) (comment-kill nil))
474 (arg
475 (save-excursion
476 (beginning-of-line)
477 (comment-search-backward)
478 (beginning-of-line)
479 (goto-char (comment-search-forward (line-end-position)))
480 (setq comment-column (current-column))
481 (message "Comment column set to %d" comment-column))
482 (comment-indent))
483 (t (setq comment-column (current-column))
484 (message "Comment column set to %d" comment-column))))
486 ;;;###autoload
487 (defun comment-kill (arg)
488 "Kill the comment on this line, if any.
489 With prefix ARG, kill comments on that many lines starting with this one."
490 (interactive "P")
491 (dotimes (_ (prefix-numeric-value arg))
492 (save-excursion
493 (beginning-of-line)
494 (let ((cs (comment-search-forward (line-end-position) t)))
495 (when cs
496 (goto-char cs)
497 (skip-syntax-backward " ")
498 (setq cs (point))
499 (comment-forward)
500 (kill-region cs (if (bolp) (1- (point)) (point)))
501 (indent-according-to-mode))))
502 (if arg (forward-line 1))))
504 (defun comment-padright (str &optional n)
505 "Construct a string composed of STR plus `comment-padding'.
506 It also adds N copies of the last non-whitespace chars of STR.
507 If STR already contains padding, the corresponding amount is
508 ignored from `comment-padding'.
509 N defaults to 0.
510 If N is `re', a regexp is returned instead, that would match
511 the string for any N."
512 (setq n (or n 0))
513 (when (and (stringp str) (not (string= "" str)))
514 ;; Separate the actual string from any leading/trailing padding
515 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
516 (let ((s (match-string 1 str)) ;actual string
517 (lpad (substring str 0 (match-beginning 1))) ;left padding
518 (rpad (concat (substring str (match-end 1)) ;original right padding
519 (substring comment-padding ;additional right padding
520 (min (- (match-end 0) (match-end 1))
521 (length comment-padding)))))
522 ;; We can only duplicate C if the comment-end has multiple chars
523 ;; or if comments can be nested, else the comment-end `}' would
524 ;; be turned into `}}}' where only the first ends the comment
525 ;; and the rest becomes bogus junk.
526 (multi (not (and comment-quote-nested
527 ;; comment-end is a single char
528 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
529 (if (not (symbolp n))
530 (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
531 ;; construct a regexp that would match anything from just S
532 ;; to any possible output of this function for any N.
533 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
534 lpad "") ;padding is not required
535 (regexp-quote s)
536 (when multi "+") ;the last char of S might be repeated
537 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
538 rpad "")))))) ;padding is not required
540 (defun comment-padleft (str &optional n)
541 "Construct a string composed of `comment-padding' plus STR.
542 It also adds N copies of the first non-whitespace chars of STR.
543 If STR already contains padding, the corresponding amount is
544 ignored from `comment-padding'.
545 N defaults to 0.
546 If N is `re', a regexp is returned instead, that would match
547 the string for any N."
548 (setq n (or n 0))
549 (when (and (stringp str) (not (string= "" str)))
550 ;; Only separate the left pad because we assume there is no right pad.
551 (string-match "\\`\\s-*" str)
552 (let ((s (substring str (match-end 0)))
553 (pad (concat (substring comment-padding
554 (min (- (match-end 0) (match-beginning 0))
555 (length comment-padding)))
556 (match-string 0 str)))
557 (c (aref str (match-end 0))) ;the first non-space char of STR
558 ;; We can only duplicate C if the comment-end has multiple chars
559 ;; or if comments can be nested, else the comment-end `}' would
560 ;; be turned into `}}}' where only the first ends the comment
561 ;; and the rest becomes bogus junk.
562 (multi (not (and comment-quote-nested
563 ;; comment-end is a single char
564 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
565 (if (not (symbolp n))
566 (concat pad (when multi (make-string n c)) s)
567 ;; Construct a regexp that would match anything from just S
568 ;; to any possible output of this function for any N.
569 ;; We match any number of leading spaces because this regexp will
570 ;; be used for uncommenting where we might want to remove
571 ;; uncomment markers with arbitrary leading space (because
572 ;; they were aligned).
573 (concat "\\s-*"
574 (if multi (concat (regexp-quote (string c)) "*"))
575 (regexp-quote s))))))
577 ;;;###autoload
578 (defun uncomment-region (beg end &optional arg)
579 "Uncomment each line in the BEG..END region.
580 The numeric prefix ARG can specify a number of chars to remove from the
581 comment markers."
582 (interactive "*r\nP")
583 (comment-normalize-vars)
584 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
585 (save-excursion
586 (goto-char beg)
587 (setq end (copy-marker end))
588 (let ((numarg (prefix-numeric-value arg))
589 spt)
590 (while (and (< (point) end)
591 (setq spt (comment-search-forward end t)))
592 (let* ((ipt (point))
593 ;; Find the end of the comment.
594 (ept (progn
595 (goto-char spt)
596 (unless (comment-forward)
597 (error "Can't find the comment end"))
598 (point)))
599 (box nil)
600 (ccs comment-continue)
601 (srei (comment-padright ccs 're))
602 (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))))
603 (save-restriction
604 (narrow-to-region spt ept)
605 ;; Remove the comment-start.
606 (goto-char ipt)
607 (skip-syntax-backward " ")
608 ;; Check for special `=' used sometimes in comment-box.
609 (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}"))
610 (skip-chars-forward "="))
611 ;; A box-comment starts with a looong comment-start marker.
612 (when (> (- (point) (point-min) (length comment-start)) 7)
613 (setq box t))
614 (when (looking-at (regexp-quote comment-padding))
615 (goto-char (match-end 0)))
616 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
617 (goto-char (match-end 0)))
618 (if (null arg) (delete-region (point-min) (point))
619 (skip-syntax-backward " ")
620 (delete-char (- numarg)))
622 ;; Remove the end-comment (and leading padding and such).
623 (goto-char (point-max)) (comment-enter-backward)
624 ;; Check for special `=' used sometimes in comment-box.
625 (when (= (- (point-max) (point)) 1)
626 (let ((pos (point)))
627 ;; skip `=' but only if there are at least 7.
628 (when (> (skip-chars-backward "=") -7) (goto-char pos))))
629 (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
630 (when (and (bolp) (not (bobp))) (backward-char))
631 (if (null arg) (delete-region (point) (point-max))
632 (skip-syntax-forward " ")
633 (delete-char numarg)))
635 ;; Unquote any nested end-comment.
636 (comment-quote-nested comment-start comment-end t)
638 ;; Eliminate continuation markers as well.
639 (when sre
640 (let* ((cce (comment-string-reverse (or comment-continue
641 comment-start)))
642 (erei (and box (comment-padleft cce 're)))
643 (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))
644 (goto-char (point-min))
645 (while (progn
646 (if (and ere (re-search-forward
647 ere (line-end-position) t))
648 (replace-match "" t t nil (if (match-end 2) 2 1))
649 (setq ere nil))
650 (forward-line 1)
651 (re-search-forward sre (line-end-position) t))
652 (replace-match "" t t nil (if (match-end 2) 2 1)))))
653 ;; Go the the end for the next comment.
654 (goto-char (point-max)))))
655 (set-marker end nil))))
657 (defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
658 "Make the leading and trailing extra lines.
659 This is used for `extra-line' style (or `box' style if BLOCK is specified)."
660 (let ((eindent 0))
661 (if (not block)
662 ;; Try to match CS and CE's content so they align aesthetically.
663 (progn
664 (setq ce (comment-string-strip ce t t))
665 (when (string-match "\\(.+\\).*\n\\(.*?\\)\\1" (concat ce "\n" cs))
666 (setq eindent
667 (max (- (match-end 2) (match-beginning 2) (match-beginning 0))
668 0))))
669 ;; box comment
670 (let* ((width (- max-indent min-indent))
671 (s (concat cs "a=m" cce))
672 (e (concat ccs "a=m" ce))
673 (c (if (string-match ".*\\S-\\S-" cs)
674 (aref cs (1- (match-end 0))) ?=))
675 (_ (string-match "\\s-*a=m\\s-*" s))
676 (fill
677 (make-string (+ width (- (match-end 0)
678 (match-beginning 0) (length cs) 3)) c)))
679 (setq cs (replace-match fill t t s))
680 (string-match "\\s-*a=m\\s-*" e)
681 (setq ce (replace-match fill t t e))))
682 (cons (concat cs "\n" (make-string min-indent ? ) ccs)
683 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce))))
685 (def-edebug-spec comment-with-narrowing t)
686 (put 'comment-with-narrowing 'lisp-indent-function 2)
687 (defmacro comment-with-narrowing (beg end &rest body)
688 "Execute BODY with BEG..END narrowing.
689 Space is added (and then removed) at the beginning for the text's
690 indentation to be kept as it was before narrowing."
691 (let ((bindent (make-symbol "bindent")))
692 `(let ((,bindent (save-excursion (goto-char beg) (current-column))))
693 (save-restriction
694 (narrow-to-region beg end)
695 (goto-char (point-min))
696 (insert (make-string ,bindent ? ))
697 (prog1
698 (progn ,@body)
699 ;; remove the bindent
700 (save-excursion
701 (goto-char (point-min))
702 (when (looking-at " *")
703 (let ((n (min (- (match-end 0) (match-beginning 0)) ,bindent)))
704 (delete-char n)
705 (setq ,bindent (- ,bindent n))))
706 (end-of-line)
707 (let ((e (point)))
708 (beginning-of-line)
709 (while (and (> ,bindent 0) (re-search-forward " *" e t))
710 (let ((n (min ,bindent (- (match-end 0) (match-beginning 0) 1))))
711 (goto-char (match-beginning 0))
712 (delete-char n)
713 (setq ,bindent (- ,bindent n)))))))))))
715 (defun comment-region-internal (beg end cs ce
716 &optional ccs cce block lines indent)
717 "Comment region BEG..END.
718 CS and CE are the comment start resp end string.
719 CCS and CCE are the comment continuation strings for the start resp end
720 of lines (default to CS and CE).
721 BLOCK indicates that end of lines should be marked with either CCE, CE or CS
722 \(if CE is empty) and that those markers should be aligned.
723 LINES indicates that an extra lines will be used at the beginning and end
724 of the region for CE and CS.
725 INDENT indicates to put CS and CCS at the current indentation of the region
726 rather than at left margin."
727 ;;(assert (< beg end))
728 (let ((no-empty t))
729 ;; Sanitize CE and CCE.
730 (if (and (stringp ce) (string= "" ce)) (setq ce nil))
731 (if (and (stringp cce) (string= "" cce)) (setq cce nil))
732 ;; If CE is empty, multiline cannot be used.
733 (unless ce (setq ccs nil cce nil))
734 ;; Should we mark empty lines as well ?
735 (if (or ccs block lines) (setq no-empty nil))
736 ;; Make sure we have end-markers for BLOCK mode.
737 (when block (unless ce (setq ce (comment-string-reverse cs))))
738 ;; If BLOCK is not requested, we don't need CCE.
739 (unless block (setq cce nil))
740 ;; Continuation defaults to the same as CS and CE.
741 (unless ccs (setq ccs cs cce ce))
743 (save-excursion
744 (goto-char end)
745 ;; If the end is not at the end of a line and the comment-end
746 ;; is implicit (i.e. a newline), explicitly insert a newline.
747 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
748 (comment-with-narrowing beg end
749 (let ((min-indent (point-max))
750 (max-indent 0))
751 (goto-char (point-min))
752 ;; Quote any nested comment marker
753 (comment-quote-nested comment-start comment-end nil)
755 ;; Loop over all lines to find the needed indentations.
756 (goto-char (point-min))
757 (while
758 (progn
759 (unless (looking-at "[ \t]*$")
760 (setq min-indent (min min-indent (current-indentation))))
761 (end-of-line)
762 (setq max-indent (max max-indent (current-column)))
763 (not (or (eobp) (progn (forward-line) nil)))))
765 ;; Inserting ccs can change max-indent by (1- tab-width).
766 (setq max-indent
767 (+ max-indent (max (length cs) (length ccs)) tab-width -1))
768 (unless indent (setq min-indent 0))
770 ;; make the leading and trailing lines if requested
771 (when lines
772 (let ((csce
773 (comment-make-extra-lines
774 cs ce ccs cce min-indent max-indent block)))
775 (setq cs (car csce))
776 (setq ce (cdr csce))))
778 (goto-char (point-min))
779 ;; Loop over all lines from BEG to END.
780 (while
781 (progn
782 (unless (and no-empty (looking-at "[ \t]*$"))
783 (move-to-column min-indent t)
784 (insert cs) (setq cs ccs) ;switch to CCS after the first line
785 (end-of-line)
786 (if (eobp) (setq cce ce))
787 (when cce
788 (when block (move-to-column max-indent t))
789 (insert cce)))
790 (end-of-line)
791 (not (or (eobp) (progn (forward-line) nil))))))))))
793 ;;;###autoload
794 (defun comment-region (beg end &optional arg)
795 "Comment or uncomment each line in the region.
796 With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END.
797 Numeric prefix arg ARG means use ARG comment characters.
798 If ARG is negative, delete that many comment characters instead.
799 By default, comments start at the left margin, are terminated on each line,
800 even for syntax in which newline does not end the comment and blank lines
801 do not get comments. This can be changed with `comment-style'.
803 The strings used as comment starts are built from
804 `comment-start' without trailing spaces and `comment-padding'."
805 (interactive "*r\nP")
806 (comment-normalize-vars)
807 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
808 (let* ((numarg (prefix-numeric-value arg))
809 (add comment-add)
810 (style (cdr (assoc comment-style comment-styles)))
811 (lines (nth 2 style))
812 (block (nth 1 style))
813 (multi (nth 0 style)))
814 (save-excursion
815 ;; we use `chars' instead of `syntax' because `\n' might be
816 ;; of end-comment syntax rather than of whitespace syntax.
817 ;; sanitize BEG and END
818 (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
819 (setq beg (max beg (point)))
820 (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
821 (setq end (min end (point)))
822 (if (>= beg end) (error "Nothing to comment"))
824 ;; sanitize LINES
825 (setq lines
826 (and
827 lines ;; multi
828 (progn (goto-char beg) (beginning-of-line)
829 (skip-syntax-forward " ")
830 (>= (point) beg))
831 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
832 (<= (point) end))
833 (or (not (string= "" comment-end)) block)
834 (progn (goto-char beg) (search-forward "\n" end t)))))
836 ;; don't add end-markers just because the user asked for `block'
837 (unless (or lines (string= "" comment-end)) (setq block nil))
839 (cond
840 ((consp arg) (uncomment-region beg end))
841 ((< numarg 0) (uncomment-region beg end (- numarg)))
843 (setq numarg (if (and (null arg) (= (length comment-start) 1))
844 add (1- numarg)))
845 (comment-region-internal
846 beg end
847 (let ((s (comment-padright comment-start numarg)))
848 (if (string-match comment-start-skip s) s
849 (comment-padright comment-start)))
850 (let ((s (comment-padleft comment-end numarg)))
851 (and s (if (string-match comment-end-skip s) s
852 (comment-padright comment-end))))
853 (if multi (comment-padright comment-continue numarg))
854 (if multi (comment-padleft (comment-string-reverse comment-continue) numarg))
855 block
856 lines
857 (nth 3 style))))))
859 (defun comment-box (beg end &optional arg)
860 "Comment out the BEG..END region, putting it inside a box.
861 The numeric prefix ARG specifies how many characters to add to begin- and
862 end- comment markers additionally to what `comment-add' already specifies."
863 (interactive "*r\np")
864 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
865 'box-multi 'box)))
866 (comment-region beg end (+ comment-add arg))))
868 ;;;###autoload
869 (defun comment-dwim (arg)
870 "Call the comment command you want (Do What I Mean).
871 If the region is active and `transient-mark-mode' is on, call
872 `comment-region' (unless it only consists of comments, in which
873 case it calls `uncomment-region').
874 Else, if the current line is empty, insert a comment and indent it.
875 Else if a prefix ARG is specified, call `comment-kill'.
876 Else, call `comment-indent'."
877 (interactive "*P")
878 (comment-normalize-vars)
879 (if (and mark-active transient-mark-mode)
880 (let ((beg (min (point) (mark)))
881 (end (max (point) (mark))))
882 (if (save-excursion ;; check for already commented region
883 (goto-char beg)
884 (comment-forward (point-max))
885 (<= end (point)))
886 (uncomment-region beg end arg)
887 (comment-region beg end arg)))
888 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
889 ;; FIXME: If there's no comment to kill on this line and ARG is
890 ;; specified, calling comment-kill is not very clever.
891 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent))
892 (let ((add (if arg (prefix-numeric-value arg)
893 (if (= (length comment-start) 1) comment-add 0))))
894 ;; Some modes insist on keeping column 0 comment in column 0
895 ;; so we need to move away from it before inserting the comment.
896 (indent-according-to-mode)
897 (insert (comment-padright comment-start add))
898 (save-excursion
899 (unless (string= "" comment-end)
900 (insert (comment-padleft comment-end add)))
901 (indent-according-to-mode))))))
903 (defcustom comment-auto-fill-only-comments nil
904 "Non-nil means to only auto-fill inside comments.
905 This has no effect in modes that do not define a comment syntax."
906 :type 'boolean
907 :group 'comment)
909 ;;;###autoload
910 (defun comment-indent-new-line (&optional soft)
911 "Break line at point and indent, continuing comment if within one.
912 This indents the body of the continued comment
913 under the previous comment line.
915 This command is intended for styles where you write a comment per line,
916 starting a new comment (and terminating it if necessary) on each line.
917 If you want to continue one comment across several lines, use \\[newline-and-indent].
919 If a fill column is specified, it overrides the use of the comment column
920 or comment indentation.
922 The inserted newline is marked hard if variable `use-hard-newlines' is true,
923 unless optional argument SOFT is non-nil."
924 (interactive)
925 (comment-normalize-vars t)
926 (let (compos comin)
927 ;; If we are not inside a comment and we only auto-fill comments,
928 ;; don't do anything (unless no comment syntax is defined).
929 (unless (and comment-start
930 comment-auto-fill-only-comments
931 (not (save-excursion
932 (prog1 (setq compos (comment-beginning))
933 (setq comin (point))))))
935 ;; Now we know we should auto-fill.
936 (delete-horizontal-space)
937 (if soft (insert-and-inherit ?\n) (newline 1))
938 (if fill-prefix
939 (progn
940 (indent-to-left-margin)
941 (insert-and-inherit fill-prefix))
943 ;; If necessary check whether we're inside a comment.
944 (unless (or comment-multi-line compos (null comment-start))
945 (save-excursion
946 (backward-char)
947 (setq compos (comment-beginning))
948 (setq comin (point))))
950 ;; If we're not inside a comment, just try to indent.
951 (if (not compos) (indent-according-to-mode)
952 (let* ((comment-column
953 ;; The continuation indentation should be somewhere between
954 ;; the current line's indentation (plus 2 for good measure)
955 ;; and the current comment's indentation, with a preference
956 ;; for comment-column.
957 (save-excursion
958 (goto-char compos)
959 (min (current-column) (max comment-column
960 (+ 2 (current-indentation))))))
961 (comstart (buffer-substring compos comin))
962 (normalp
963 (string-match (regexp-quote (comment-string-strip
964 comment-start t t))
965 comstart))
966 (comment-end
967 (if normalp comment-end
968 ;; The comment starter is not the normal comment-start
969 ;; so we can't just use comment-end.
970 (save-excursion
971 (goto-char compos)
972 (if (not (comment-forward)) comment-end
973 (comment-string-strip
974 (buffer-substring
975 (save-excursion (comment-enter-backward) (point))
976 (point))
977 nil t)))))
978 (comment-start comstart)
979 ;; Force comment-continue to be recreated from comment-start.
980 (comment-continue nil))
981 (insert-and-inherit ?\n)
982 (forward-char -1)
983 (comment-indent (cadr (assoc comment-style comment-styles)))
984 (save-excursion
985 (let ((pt (point)))
986 (end-of-line)
987 (let ((comend (buffer-substring pt (point))))
988 ;; The 1+ is to make sure we delete the \n inserted above.
989 (delete-region pt (1+ (point)))
990 (beginning-of-line)
991 (backward-char)
992 (insert comend)
993 (forward-char))))))))))
995 (provide 'newcomment)
997 ;;; newcomment.el ends here