Docstring fixes.
[bpt/emacs.git] / lisp / newcomment.el
CommitLineData
83b96b22
SM
1;;; newcomment.el --- (un)comment regions of buffers
2
39cb51e7 3;; Copyright (C) 1999, 2000 Free Software Foundation Inc.
83b96b22 4
59a1ce8d 5;; Author: code extracted from Emacs-20's simple.el
771c9b97 6;; Maintainer: Stefan Monnier <monnier@cs.yale.edu>
83b96b22 7;; Keywords: comment uncomment
75ed43a6 8;; Revision: $Id: newcomment.el,v 1.30 2001/02/22 01:47:40 monnier Exp $
83b96b22 9
59a1ce8d
SM
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
83b96b22 13;; it under the terms of the GNU General Public License as published by
59a1ce8d
SM
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
83b96b22
SM
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.
59a1ce8d 21
83b96b22 22;; You should have received a copy of the GNU General Public License
59a1ce8d
SM
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.
83b96b22
SM
26
27;;; Commentary:
28
771c9b97 29;; A replacement for simple.el's comment-related functions.
83b96b22
SM
30
31;;; Bugs:
32
2ab98065
SM
33;; - single-char nestable comment-start can only do the "\\s<+" stuff
34;; if the corresponding closing marker happens to be right.
771c9b97 35;; - comment-box in TeXinfo generate bogus comments @ccccc@
3e569d22
SM
36;; - uncomment-region with a numeric argument can render multichar
37;; comment markers invalid.
3fc5b4e2
SM
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.
83b96b22
SM
43
44;;; Todo:
45
771c9b97
SM
46;; - try to align tail comments
47;; - check what c-comment-line-break-function has to say
3e569d22 48;; - spill auto-fill of comments onto the end of the next line
7a0a180a
SM
49;; - uncomment-region with a consp (for blocks) or somehow make the
50;; deletion of continuation markers less dangerous
2ab98065 51;; - drop block-comment-<foo> unless it's really used
f5215400 52;; - uncomment-region on a subpart of a comment
771c9b97 53;; - support gnu-style "multi-line with space in continue"
771c9b97
SM
54;; - somehow allow comment-dwim to use the region even if transient-mark-mode
55;; is not turned on.
83b96b22 56
bdbe3a89
SM
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).
61
83b96b22
SM
62;;; Code:
63
be83ecb2 64;;;###autoload
59a1ce8d 65(defalias 'indent-for-comment 'comment-indent)
be83ecb2 66;;;###autoload
59a1ce8d 67(defalias 'set-comment-column 'comment-set-column)
be83ecb2 68;;;###autoload
59a1ce8d 69(defalias 'kill-comment 'comment-kill)
be83ecb2 70;;;###autoload
59a1ce8d 71(defalias 'indent-new-comment-line 'comment-indent-new-line)
83b96b22 72
be83ecb2 73;;;###autoload
3e569d22
SM
74(defgroup comment nil
75 "Indenting and filling of comments."
76 :prefix "comment-"
ac87b3a9 77 :version "21.1"
3e569d22
SM
78 :group 'fill)
79
771c9b97
SM
80(defvar comment-use-syntax 'undecided
81 "Non-nil if syntax-tables can be used instead of regexps.
82Can also be `undecided' which means that a somewhat expensive test will
83be used to try to determine whether syntax-tables should be trusted
f5215400
SM
84to understand comments or not in the given buffer.
85Major modes should set this variable.")
2ab98065 86
be83ecb2 87;;;###autoload
83b96b22
SM
88(defcustom comment-column 32
89 "*Column to indent right-margin comments to.
90Setting this variable automatically makes it local to the current buffer.
91Each mode establishes a different default value for this variable; you
92can set the value for a particular mode using that mode's hook."
93 :type 'integer
3e569d22 94 :group 'comment)
83b96b22
SM
95(make-variable-buffer-local 'comment-column)
96
be83ecb2 97;;;###autoload
f5215400
SM
98(defvar comment-start nil
99 "*String to insert to start a new comment, or nil if no comment syntax.")
83b96b22 100
be83ecb2 101;;;###autoload
f5215400 102(defvar comment-start-skip nil
83b96b22
SM
103 "*Regexp to match the start of a comment plus everything up to its body.
104If there are any \\(...\\) pairs, the comment delimiter text is held to begin
f5215400 105at the place matched by the close of the first pair.")
771c9b97 106
be83ecb2 107;;;###autoload
3e569d22
SM
108(defvar comment-end-skip nil
109 "Regexp to match the end of a comment plus everything up to its body.")
83b96b22 110
be83ecb2 111;;;###autoload
f5215400 112(defvar comment-end ""
83b96b22 113 "*String to insert to end a new comment.
f5215400 114Should be an empty string if comments are terminated by end-of-line.")
83b96b22 115
be83ecb2 116;;;###autoload
87cf8421 117(defvar comment-indent-function 'comment-indent-default
83b96b22
SM
118 "Function to compute desired indentation for a comment.
119This function is called with no args with point at the beginning of
87cf8421
SM
120the comment's starting delimiter and should return either the desired
121column indentation or nil.
122If nil is returned, indentation is delegated to `indent-according-to-mode'.")
83b96b22 123
3e569d22
SM
124(defvar block-comment-start nil)
125(defvar block-comment-end nil)
83b96b22 126
771c9b97
SM
127(defvar comment-quote-nested t
128 "Non-nil if nested comments should be quoted.
129This should be locally set by each major mode if needed.")
130
131(defvar comment-continue nil
f5215400
SM
132 "Continuation string to insert for multiline comments.
133This string will be added at the beginning of each line except the very
134first one when commenting a region with a commenting style that allows
135comments to span several lines.
136It should generally have the same length as `comment-start' in order to
137preserve indentation.
138If it is nil a value will be automatically derived from `comment-start'
139by replacing its first character with a space.")
140
771c9b97 141(defvar comment-add 0
f5215400
SM
142 "How many more comment chars should be inserted by `comment-region'.
143This determines the default value of the numeric argument of `comment-region'.
144This should generally stay 0, except for a few modes like Lisp where
145it can be convenient to set it to 1 so that regions are commented with
146two semi-colons.")
2ab98065 147
2ab98065 148(defconst comment-styles
771c9b97
SM
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))
9b0d1d6e
SM
154 (box . (nil t t t))
155 (box-multi . (t t t t)))
f5215400
SM
156 "Possible comment styles of the form (STYLE . (MULTI ALIGN EXTRA INDENT)).
157STYLE should be a mnemonic symbol.
158MULTI specifies that comments are allowed to span multiple lines.
159ALIGN specifies that the `comment-end' markers should be aligned.
160EXTRA specifies that an extra line should be used before and after the
161 region to comment (to put the `comment-end' and `comment-start').
162INDENT 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.")
164
be83ecb2 165;;;###autoload
f5215400
SM
166(defcustom comment-style 'plain
167 "*Style to be used for `comment-region'.
168See `comment-styles' for a list of available styles."
169 :group 'comment
be83ecb2
SM
170 :type (if (boundp 'comment-styles)
171 `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles))
172 'symbol))
2ab98065 173
be83ecb2
SM
174;;;###autoload
175(defcustom comment-padding " "
f5215400
SM
176 "Padding string that `comment-region' puts between comment chars and text.
177Can also be an integer which will be automatically turned into a string
178of the corresponding number of spaces.
2ab98065
SM
179
180Extra spacing between the comment characters and the comment text
771c9b97 181makes the comment easier to read. Default is 1. nil means 0.")
2ab98065 182
be83ecb2 183;;;###autoload
3e569d22 184(defcustom comment-multi-line nil
ac87b3a9 185 "*Non-nil means \\[comment-indent-new-line] continues comments, with no new terminator or starter.
3e569d22
SM
186This is obsolete because you might as well use \\[newline-and-indent]."
187 :type 'boolean
188 :group 'comment)
189
2ab98065
SM
190;;;;
191;;;; Helpers
192;;;;
193
f5215400
SM
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-*")
ad679e45 197 "\\(.*?\\)" (if afterp "\\s-*\n?")
2ab98065
SM
198 "\\'") str)
199 (match-string 1 str))
200
201(defun comment-string-reverse (s)
f5215400 202 "Return the mirror image of string S, without any trailing space."
771c9b97 203 (comment-string-strip (concat (nreverse (string-to-list s))) nil t))
2ab98065
SM
204
205(defun comment-normalize-vars (&optional noerror)
206 (if (not comment-start) (or noerror (error "No comment syntax is defined"))
207 ;; comment-use-syntax
771c9b97 208 (when (eq comment-use-syntax 'undecided)
2ab98065
SM
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)))
771c9b97
SM
213 ;; Try to skip over a comment using forward-comment
214 ;; to see if the syntax tables properly recognize it.
2ab98065
SM
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))))))
2ab98065
SM
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
f5215400 227 (unless (or comment-continue (string= comment-end ""))
2ab98065 228 (set (make-local-variable 'comment-continue)
9b0d1d6e
SM
229 (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
230 (substring comment-start 1))))
2ab98065
SM
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))
75ed43a6
SM
236 ;; Let's not allow any \s- but only [ \t] since \n
237 ;; might be both a comment-end marker and \s-.
238 "+\\)[ \t]*")))
2ab98065
SM
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)
771c9b97 243 (concat "\\s-*\\(\\s>" (if comment-quote-nested "" "+")
2ab98065 244 "\\|" (regexp-quote (substring ce 0 1))
771c9b97 245 (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
2ab98065
SM
246 (regexp-quote (substring ce 1))
247 "\\)"))))))
248
f5215400
SM
249(defun comment-quote-re (str unp)
250 (concat (regexp-quote (substring str 0 1))
251 "\\\\" (if unp "+" "*")
252 (regexp-quote (substring str 1))))
253
254(defun comment-quote-nested (cs ce unp)
255 "Quote or unquote nested comments.
256If 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))))))))
2ab98065
SM
281
282;;;;
283;;;; Navigation
284;;;;
285
ad679e45 286(defun comment-search-forward (limit &optional noerror)
771c9b97
SM
287 "Find a comment start between point and LIMIT.
288Moves point to inside the comment and returns the position of the
289comment-starter. If no comment is found, moves point to LIMIT
e8fe7d39 290and raises an error or returns nil of NOERROR is non-nil."
2ab98065 291 (if (not comment-use-syntax)
9b0d1d6e
SM
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")))
ad679e45
SM
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.
9b0d1d6e 309 (let ((pos (point))
ad679e45 310 (start (nth 8 s))
9b0d1d6e 311 (bol (line-beginning-position))
ad679e45
SM
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)))
9b0d1d6e 317 (goto-char (or end pos))
ad679e45 318 start)))))
2ab98065
SM
319
320(defun comment-search-backward (&optional limit noerror)
321 "Find a comment start between LIMIT and point.
771c9b97
SM
322Moves point to inside the comment and returns the position of the
323comment-starter. If no comment is found, moves point to LIMIT
2ab98065 324and raises an error or returns nil of NOERROR is non-nil."
ad679e45
SM
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.
2ab98065
SM
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))))
346
347(defun comment-beginning ()
771c9b97
SM
348 "Find the beginning of the enclosing comment.
349Returns nil if not inside a comment, else moves point and returns
2ab98065 350the same as `comment-search-forward'."
75ed43a6
SM
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)))
360 cs
361 (goto-char pt)
362 nil)))))
2ab98065
SM
363
364(defun comment-forward (&optional n)
365 "Skip forward over N comments.
366Just like `forward-comment' but only for positive N
367and 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 " ")
59a1ce8d
SM
373 (setq n
374 (if (and (looking-at comment-start-skip)
76a4de07 375 (goto-char (match-end 0))
59a1ce8d
SM
376 (re-search-forward comment-end-skip nil 'move))
377 (1- n) -1)))
2ab98065
SM
378 (= n 0))))
379
380(defun comment-enter-backward ()
381 "Move from the end of a comment to the end of its content.
771c9b97 382Point is assumed to be just at the end of a comment."
2ab98065
SM
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)
ad679e45
SM
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 " "))))))
2ab98065
SM
399
400;;;;
401;;;; Commands
402;;;;
403
fae99944 404;;;###autoload
87cf8421
SM
405(defun comment-indent-default ()
406 "Default for `comment-indent-function'."
d3fcda22
SM
407 (if (and (looking-at "\\s<\\s<\\(\\s<\\)?")
408 (or (match-end 1) (/= (current-column) (current-indentation))))
409 0
87cf8421
SM
410 (when (or (/= (current-column) (current-indentation))
411 (and (> comment-add 0) (looking-at "\\s<\\S<")))
412 comment-column)))
413
be83ecb2 414;;;###autoload
3e569d22 415(defun comment-indent (&optional continue)
2ab98065
SM
416 "Indent this line's comment to comment column, or insert an empty comment.
417If CONTINUE is non-nil, use the `comment-continuation' markers if any."
83b96b22 418 (interactive "*")
ad679e45 419 (comment-normalize-vars)
83b96b22
SM
420 (let* ((empty (save-excursion (beginning-of-line)
421 (looking-at "[ \t]*$")))
f5215400 422 (starter (or (and continue comment-continue)
2ab98065 423 (and empty block-comment-start) comment-start))
f5215400 424 (ender (or (and continue comment-continue "")
2ab98065 425 (and empty block-comment-end) comment-end)))
2e1fbba4
SM
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))
bb304a7a 439 (insert starter)
2e1fbba4
SM
440 (setq cpos (point-marker))
441 (insert ender)))
442 (goto-char begpos)
443 ;; Compute desired indent.
053b8d35 444 (setq indent (save-excursion (funcall comment-indent-function)))
2e1fbba4
SM
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))))
83b96b22 463
be83ecb2 464;;;###autoload
3e569d22 465(defun comment-set-column (arg)
83b96b22 466 "Set the comment column based on point.
2ab98065 467With no ARG, set the comment column to the current column.
83b96b22
SM
468With just minus as arg, kill any comment on this line.
469With 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")
e8fe7d39 472 (cond
ad679e45 473 ((eq arg '-) (comment-kill nil))
e8fe7d39
SM
474 (arg
475 (save-excursion
476 (beginning-of-line)
2ab98065 477 (comment-search-backward)
e8fe7d39 478 (beginning-of-line)
ad679e45 479 (goto-char (comment-search-forward (line-end-position)))
83b96b22 480 (setq comment-column (current-column))
e8fe7d39 481 (message "Comment column set to %d" comment-column))
ad679e45 482 (comment-indent))
e8fe7d39 483 (t (setq comment-column (current-column))
83b96b22
SM
484 (message "Comment column set to %d" comment-column))))
485
be83ecb2 486;;;###autoload
3e569d22 487(defun comment-kill (arg)
7a0a180a
SM
488 "Kill the comment on this line, if any.
489With prefix ARG, kill comments on that many lines starting with this one."
490 (interactive "P")
ad679e45
SM
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))))
7a0a180a 503
2ab98065
SM
504(defun comment-padright (str &optional n)
505 "Construct a string composed of STR plus `comment-padding'.
f5215400 506It also adds N copies of the last non-whitespace chars of STR.
2ab98065 507If STR already contains padding, the corresponding amount is
f5215400
SM
508ignored from `comment-padding'.
509N defaults to 0.
771c9b97 510If N is `re', a regexp is returned instead, that would match
f5215400 511the string for any N."
2ab98065
SM
512 (setq n (or n 0))
513 (when (and (stringp str) (not (string= "" str)))
f5215400 514 ;; Separate the actual string from any leading/trailing padding
3e569d22 515 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
f5215400
SM
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
3e569d22 520 (min (- (match-end 0) (match-end 1))
9b0d1d6e
SM
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)))))
f5215400 529 (if (not (symbolp n))
9b0d1d6e 530 (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
f5215400
SM
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
9b0d1d6e
SM
535 (regexp-quote s)
536 (when multi "+") ;the last char of S might be repeated
f5215400
SM
537 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
538 rpad "")))))) ;padding is not required
2ab98065
SM
539
540(defun comment-padleft (str &optional n)
541 "Construct a string composed of `comment-padding' plus STR.
f5215400 542It also adds N copies of the first non-whitespace chars of STR.
2ab98065 543If STR already contains padding, the corresponding amount is
f5215400
SM
544ignored from `comment-padding'.
545N defaults to 0.
771c9b97 546If N is `re', a regexp is returned instead, that would match
2ab98065
SM
547 the string for any N."
548 (setq n (or n 0))
549 (when (and (stringp str) (not (string= "" str)))
f5215400 550 ;; Only separate the left pad because we assume there is no right pad.
2ab98065
SM
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)))
f5215400
SM
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))))))
83b96b22 576
be83ecb2 577;;;###autoload
7a0a180a
SM
578(defun uncomment-region (beg end &optional arg)
579 "Uncomment each line in the BEG..END region.
f5215400
SM
580The numeric prefix ARG can specify a number of chars to remove from the
581comment markers."
83b96b22
SM
582 (interactive "*r\nP")
583 (comment-normalize-vars)
584 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
585 (save-excursion
7a0a180a 586 (goto-char beg)
f5215400 587 (setq end (copy-marker end))
7a0a180a 588 (let ((numarg (prefix-numeric-value arg))
2ab98065 589 spt)
7a0a180a 590 (while (and (< (point) end)
2ab98065
SM
591 (setq spt (comment-search-forward end t)))
592 (let* ((ipt (point))
f5215400 593 ;; Find the end of the comment.
e8fe7d39 594 (ept (progn
2ab98065
SM
595 (goto-char spt)
596 (unless (comment-forward)
e8fe7d39 597 (error "Can't find the comment end"))
f5215400
SM
598 (point)))
599 (box nil)
600 (ccs comment-continue)
2ab98065 601 (srei (comment-padright ccs 're))
3e569d22 602 (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))))
e8fe7d39
SM
603 (save-restriction
604 (narrow-to-region spt ept)
f5215400 605 ;; Remove the comment-start.
2ab98065
SM
606 (goto-char ipt)
607 (skip-syntax-backward " ")
9b0d1d6e
SM
608 ;; Check for special `=' used sometimes in comment-box.
609 (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}"))
610 (skip-chars-forward "="))
f5215400 611 ;; A box-comment starts with a looong comment-start marker.
2ab98065 612 (when (> (- (point) (point-min) (length comment-start)) 7)
f5215400 613 (setq box t))
2ab98065
SM
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)))
3e569d22
SM
618 (if (null arg) (delete-region (point-min) (point))
619 (skip-syntax-backward " ")
620 (delete-char (- numarg)))
2ab98065 621
f5215400 622 ;; Remove the end-comment (and leading padding and such).
2ab98065 623 (goto-char (point-max)) (comment-enter-backward)
9b0d1d6e 624 ;; Check for special `=' used sometimes in comment-box.
6dcd3806
SM
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))))
9b0d1d6e 629 (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
2ab98065 630 (when (and (bolp) (not (bobp))) (backward-char))
f5215400 631 (if (null arg) (delete-region (point) (point-max))
3e569d22
SM
632 (skip-syntax-forward " ")
633 (delete-char numarg)))
e8fe7d39 634
f5215400
SM
635 ;; Unquote any nested end-comment.
636 (comment-quote-nested comment-start comment-end t)
637
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-*$"))))
7a0a180a 644 (goto-char (point-min))
f5215400
SM
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))
2ab98065 652 (replace-match "" t t nil (if (match-end 2) 2 1)))))
f5215400
SM
653 ;; Go the the end for the next comment.
654 (goto-char (point-max)))))
655 (set-marker end nil))))
83b96b22 656
aac88001 657(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
ad679e45
SM
658 "Make the leading and trailing extra lines.
659This is used for `extra-line' style (or `box' style if BLOCK is specified)."
9b0d1d6e
SM
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))) ?=))
3fc5b4e2 675 (_ (string-match "\\s-*a=m\\s-*" s))
9b0d1d6e
SM
676 (fill
677 (make-string (+ width (- (match-end 0)
678 (match-beginning 0) (length cs) 3)) c)))
aac88001 679 (setq cs (replace-match fill t t s))
3fc5b4e2 680 (string-match "\\s-*a=m\\s-*" e)
9b0d1d6e
SM
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))))
aac88001
SM
684
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.
689Space is added (and then removed) at the beginning for the text's
690indentation to be kept as it was before narrowing."
59a1ce8d
SM
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)))
aac88001 704 (delete-char n)
59a1ce8d
SM
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)))))))))))
aac88001 714
771c9b97
SM
715(defun comment-region-internal (beg end cs ce
716 &optional ccs cce block lines indent)
f5215400 717 "Comment region BEG..END.
4125ec7e
SM
718CS and CE are the comment start resp end string.
719CCS and CCE are the comment continuation strings for the start resp end
f5215400
SM
720of lines (default to CS and CE).
721BLOCK 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.
723LINES indicates that an extra lines will be used at the beginning and end
724of the region for CE and CS.
725INDENT indicates to put CS and CCS at the current indentation of the region
726rather than at left margin."
59a1ce8d 727 ;;(assert (< beg end))
83b96b22 728 (let ((no-empty t))
f5215400 729 ;; Sanitize CE and CCE.
83b96b22
SM
730 (if (and (stringp ce) (string= "" ce)) (setq ce nil))
731 (if (and (stringp cce) (string= "" cce)) (setq cce nil))
f5215400
SM
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 ?
83b96b22 735 (if (or ccs block lines) (setq no-empty nil))
f5215400 736 ;; Make sure we have end-markers for BLOCK mode.
2ab98065 737 (when block (unless ce (setq ce (comment-string-reverse cs))))
f5215400
SM
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))
7a0a180a 742
83b96b22 743 (save-excursion
aac88001 744 (goto-char end)
f5215400
SM
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.
aac88001
SM
747 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
748 (comment-with-narrowing beg end
f5215400 749 (let ((min-indent (point-max))
83b96b22
SM
750 (max-indent 0))
751 (goto-char (point-min))
f5215400
SM
752 ;; Quote any nested comment marker
753 (comment-quote-nested comment-start comment-end nil)
754
755 ;; Loop over all lines to find the needed indentations.
4125ec7e 756 (goto-char (point-min))
f5215400
SM
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)))))
764
765 ;; Inserting ccs can change max-indent by (1- tab-width).
59a1ce8d
SM
766 (setq max-indent
767 (+ max-indent (max (length cs) (length ccs)) tab-width -1))
771c9b97 768 (unless indent (setq min-indent 0))
83b96b22 769
aac88001 770 ;; make the leading and trailing lines if requested
83b96b22 771 (when lines
771c9b97
SM
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))))
83b96b22
SM
777
778 (goto-char (point-min))
779 ;; Loop over all lines from BEG to END.
f5215400
SM
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))))))))))
83b96b22 792
be83ecb2 793;;;###autoload
83b96b22
SM
794(defun comment-region (beg end &optional arg)
795 "Comment or uncomment each line in the region.
39cb51e7 796With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END.
83b96b22
SM
797Numeric prefix arg ARG means use ARG comment characters.
798If ARG is negative, delete that many comment characters instead.
be83ecb2
SM
799By default, comments start at the left margin, are terminated on each line,
800even for syntax in which newline does not end the comment and blank lines
801do not get comments. This can be changed with `comment-style'.
83b96b22
SM
802
803The 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)))
2ab98065 808 (let* ((numarg (prefix-numeric-value arg))
771c9b97 809 (add comment-add)
2ab98065
SM
810 (style (cdr (assoc comment-style comment-styles)))
811 (lines (nth 2 style))
812 (block (nth 1 style))
813 (multi (nth 0 style)))
83b96b22
SM
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"))
823
83b96b22
SM
824 ;; sanitize LINES
825 (setq lines
826 (and
9b0d1d6e 827 lines ;; multi
83b96b22
SM
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))
771c9b97 833 (or (not (string= "" comment-end)) block)
2ab98065 834 (progn (goto-char beg) (search-forward "\n" end t)))))
83b96b22 835
2ab98065
SM
836 ;; don't add end-markers just because the user asked for `block'
837 (unless (or lines (string= "" comment-end)) (setq block nil))
838
83b96b22
SM
839 (cond
840 ((consp arg) (uncomment-region beg end))
841 ((< numarg 0) (uncomment-region beg end (- numarg)))
842 (t
59a1ce8d
SM
843 (setq numarg (if (and (null arg) (= (length comment-start) 1))
844 add (1- numarg)))
83b96b22
SM
845 (comment-region-internal
846 beg end
3e569d22
SM
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))))
f5215400
SM
853 (if multi (comment-padright comment-continue numarg))
854 (if multi (comment-padleft (comment-string-reverse comment-continue) numarg))
83b96b22 855 block
771c9b97
SM
856 lines
857 (nth 3 style))))))
858
859(defun comment-box (beg end &optional arg)
860 "Comment out the BEG..END region, putting it inside a box.
861The numeric prefix ARG specifies how many characters to add to begin- and
862end- comment markers additionally to what `comment-add' already specifies."
863 (interactive "*r\np")
9b0d1d6e
SM
864 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
865 'box-multi 'box)))
771c9b97 866 (comment-region beg end (+ comment-add arg))))
83b96b22 867
be83ecb2 868;;;###autoload
2ab98065 869(defun comment-dwim (arg)
ad679e45
SM
870 "Call the comment command you want (Do What I Mean).
871If the region is active and `transient-mark-mode' is on, call
39cb51e7 872 `comment-region' (unless it only consists of comments, in which
ad679e45 873 case it calls `uncomment-region').
2ab98065 874Else, if the current line is empty, insert a comment and indent it.
ad679e45
SM
875Else if a prefix ARG is specified, call `comment-kill'.
876Else, call `comment-indent'."
2ab98065
SM
877 (interactive "*P")
878 (comment-normalize-vars)
771c9b97 879 (if (and mark-active transient-mark-mode)
2ab98065
SM
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-*$")))
ad679e45
SM
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))
2ab98065 892 (let ((add (if arg (prefix-numeric-value arg)
771c9b97 893 (if (= (length comment-start) 1) comment-add 0))))
2e1fbba4
SM
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)
2ab98065
SM
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))))))
902
392f1ef5
SM
903(defcustom comment-auto-fill-only-comments nil
904 "Non-nil means to only auto-fill inside comments.
905This has no effect in modes that do not define a comment syntax."
906 :type 'boolean
907 :group 'comment)
908
be83ecb2 909;;;###autoload
ad679e45 910(defun comment-indent-new-line (&optional soft)
2ab98065
SM
911 "Break line at point and indent, continuing comment if within one.
912This indents the body of the continued comment
913under the previous comment line.
914
915This command is intended for styles where you write a comment per line,
916starting a new comment (and terminating it if necessary) on each line.
917If you want to continue one comment across several lines, use \\[newline-and-indent].
918
919If a fill column is specified, it overrides the use of the comment column
920or comment indentation.
921
922The inserted newline is marked hard if variable `use-hard-newlines' is true,
923unless optional argument SOFT is non-nil."
924 (interactive)
925 (comment-normalize-vars t)
59a1ce8d
SM
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).
392f1ef5
SM
929 (unless (and comment-start
930 comment-auto-fill-only-comments
931 (not (save-excursion
59a1ce8d 932 (prog1 (setq compos (comment-beginning))
392f1ef5 933 (setq comin (point))))))
59a1ce8d
SM
934
935 ;; Now we know we should auto-fill.
adf9c994 936 (delete-horizontal-space)
392f1ef5
SM
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))
59a1ce8d
SM
942
943 ;; If necessary check whether we're inside a comment.
944 (unless (or comment-multi-line compos (null comment-start))
392f1ef5
SM
945 (save-excursion
946 (backward-char)
59a1ce8d
SM
947 (setq compos (comment-beginning))
948 (setq comin (point))))
949
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))))))))))
2ab98065 994
83b96b22
SM
995(provide 'newcomment)
996
83b96b22 997;;; newcomment.el ends here