Merge from emacs-23
[bpt/emacs.git] / lisp / newcomment.el
CommitLineData
83b96b22
SM
1;;; newcomment.el --- (un)comment regions of buffers
2
c90f2757 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
5df4f04c 4;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
83b96b22 5
59a1ce8d 6;; Author: code extracted from Emacs-20's simple.el
e8bf8343 7;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca>
83b96b22 8;; Keywords: comment uncomment
bd78fa1d 9;; Package: emacs
83b96b22 10
59a1ce8d
SM
11;; This file is part of GNU Emacs.
12
eb3fa2cf 13;; GNU Emacs is free software: you can redistribute it and/or modify
83b96b22 14;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
59a1ce8d
SM
17
18;; GNU Emacs is distributed in the hope that it will be useful,
83b96b22
SM
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
59a1ce8d 22
83b96b22 23;; You should have received a copy of the GNU General Public License
eb3fa2cf 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
83b96b22
SM
25
26;;; Commentary:
27
771c9b97 28;; A replacement for simple.el's comment-related functions.
83b96b22
SM
29
30;;; Bugs:
31
3674a4a9
SM
32;; - boxed comments in Perl are not properly uncommented because they are
33;; uncommented one-line at a time.
75e95a97 34;; - nested comments in sgml-mode are not properly quoted.
2ab98065
SM
35;; - single-char nestable comment-start can only do the "\\s<+" stuff
36;; if the corresponding closing marker happens to be right.
3e569d22
SM
37;; - uncomment-region with a numeric argument can render multichar
38;; comment markers invalid.
3fc5b4e2
SM
39;; - comment-indent or comment-region when called inside a comment
40;; will happily break the surrounding comment.
41;; - comment-quote-nested will not (un)quote properly all nested comment
42;; markers if there are more than just comment-start and comment-end.
43;; For example, in Pascal where {...*) and (*...} are possible.
83b96b22
SM
44
45;;; Todo:
46
3674a4a9
SM
47;; - rebox.el-style refill.
48;; - quantized steps in comment-alignment.
49;; - try to align tail comments.
50;; - check what c-comment-line-break-function has to say.
51;; - spill auto-fill of comments onto the end of the next line.
7a0a180a 52;; - uncomment-region with a consp (for blocks) or somehow make the
3674a4a9
SM
53;; deletion of continuation markers less dangerous.
54;; - drop block-comment-<foo> unless it's really used.
55;; - uncomment-region on a subpart of a comment.
56;; - support gnu-style "multi-line with space in continue".
771c9b97
SM
57;; - somehow allow comment-dwim to use the region even if transient-mark-mode
58;; is not turned on.
83b96b22 59
bdbe3a89
SM
60;; - when auto-filling a comment, try to move the comment to the left
61;; rather than break it (if possible).
62;; - sometimes default the comment-column to the same
63;; one used on the preceding line(s).
64
83b96b22
SM
65;;; Code:
66
be83ecb2 67;;;###autoload
59a1ce8d 68(defalias 'indent-for-comment 'comment-indent)
be83ecb2 69;;;###autoload
59a1ce8d 70(defalias 'set-comment-column 'comment-set-column)
be83ecb2 71;;;###autoload
59a1ce8d 72(defalias 'kill-comment 'comment-kill)
be83ecb2 73;;;###autoload
59a1ce8d 74(defalias 'indent-new-comment-line 'comment-indent-new-line)
83b96b22 75
3e569d22
SM
76(defgroup comment nil
77 "Indenting and filling of comments."
78 :prefix "comment-"
ac87b3a9 79 :version "21.1"
3e569d22
SM
80 :group 'fill)
81
75975685
RS
82;; Autoload this to avoid warnings, since some major modes define it.
83;;;###autoload
771c9b97
SM
84(defvar comment-use-syntax 'undecided
85 "Non-nil if syntax-tables can be used instead of regexps.
86Can also be `undecided' which means that a somewhat expensive test will
87be used to try to determine whether syntax-tables should be trusted
f5215400
SM
88to understand comments or not in the given buffer.
89Major modes should set this variable.")
2ab98065 90
88fe06af
SM
91(defcustom comment-fill-column nil
92 "Column to use for `comment-indent'. If nil, use `fill-column' instead."
f5307782
JB
93 :type '(choice (const nil) integer)
94 :group 'comment)
88fe06af 95
be83ecb2 96;;;###autoload
83b96b22 97(defcustom comment-column 32
ae2c9c21 98 "Column to indent right-margin comments to.
2ed8e1f7 99Each mode may establish a different default value for this variable; you
a704fec0 100can set the value for a particular mode using that mode's hook.
2ed8e1f7
SM
101Comments might be indented to a different value in order not to go beyond
102`comment-fill-column' or in order to align them with surrounding comments."
f5307782
JB
103 :type 'integer
104 :group 'comment)
83b96b22 105(make-variable-buffer-local 'comment-column)
631c8020 106;;;###autoload(put 'comment-column 'safe-local-variable 'integerp)
83b96b22 107
be83ecb2 108;;;###autoload
f5215400
SM
109(defvar comment-start nil
110 "*String to insert to start a new comment, or nil if no comment syntax.")
be2c62b3 111;;;###autoload(put 'comment-start 'safe-local-variable 'string-or-null-p)
83b96b22 112
be83ecb2 113;;;###autoload
f5215400 114(defvar comment-start-skip nil
83b96b22
SM
115 "*Regexp to match the start of a comment plus everything up to its body.
116If there are any \\(...\\) pairs, the comment delimiter text is held to begin
f5215400 117at the place matched by the close of the first pair.")
be2c62b3 118;;;###autoload(put 'comment-start-skip 'safe-local-variable 'string-or-null-p)
771c9b97 119
be83ecb2 120;;;###autoload
3e569d22
SM
121(defvar comment-end-skip nil
122 "Regexp to match the end of a comment plus everything up to its body.")
be2c62b3 123;;;###autoload(put 'comment-end-skip 'safe-local-variable 'string-or-null-p)
83b96b22 124
be83ecb2 125;;;###autoload
aaa448c9 126(defvar comment-end (purecopy "")
83b96b22 127 "*String to insert to end a new comment.
f5215400 128Should be an empty string if comments are terminated by end-of-line.")
be2c62b3 129;;;###autoload(put 'comment-end 'safe-local-variable 'string-or-null-p)
83b96b22 130
be83ecb2 131;;;###autoload
87cf8421 132(defvar comment-indent-function 'comment-indent-default
83b96b22
SM
133 "Function to compute desired indentation for a comment.
134This function is called with no args with point at the beginning of
87cf8421
SM
135the comment's starting delimiter and should return either the desired
136column indentation or nil.
137If nil is returned, indentation is delegated to `indent-according-to-mode'.")
83b96b22 138
a71b3805
EZ
139;;;###autoload
140(defvar comment-insert-comment-function nil
141 "Function to insert a comment when a line doesn't contain one.
142The function has no args.
143
144Applicable at least in modes for languages like fixed-format Fortran where
145comments always start in column zero.")
146
b70dd952 147(defvar comment-region-function 'comment-region-default
a71b3805
EZ
148 "Function to comment a region.
149Its args are the same as those of `comment-region', but BEG and END are
150guaranteed to be correctly ordered. It is called within `save-excursion'.
151
152Applicable at least in modes for languages like fixed-format Fortran where
153comments always start in column zero.")
154
b70dd952 155(defvar uncomment-region-function 'uncomment-region-default
a71b3805
EZ
156 "Function to uncomment a region.
157Its args are the same as those of `uncomment-region', but BEG and END are
158guaranteed to be correctly ordered. It is called within `save-excursion'.
159
160Applicable at least in modes for languages like fixed-format Fortran where
161comments always start in column zero.")
162
163;; ?? never set
3e569d22
SM
164(defvar block-comment-start nil)
165(defvar block-comment-end nil)
83b96b22 166
771c9b97
SM
167(defvar comment-quote-nested t
168 "Non-nil if nested comments should be quoted.
169This should be locally set by each major mode if needed.")
170
171(defvar comment-continue nil
f5215400
SM
172 "Continuation string to insert for multiline comments.
173This string will be added at the beginning of each line except the very
174first one when commenting a region with a commenting style that allows
175comments to span several lines.
176It should generally have the same length as `comment-start' in order to
177preserve indentation.
178If it is nil a value will be automatically derived from `comment-start'
179by replacing its first character with a space.")
180
771c9b97 181(defvar comment-add 0
f5215400
SM
182 "How many more comment chars should be inserted by `comment-region'.
183This determines the default value of the numeric argument of `comment-region'.
c391a81f
RS
184The `plain' comment style doubles this value.
185
f5215400 186This should generally stay 0, except for a few modes like Lisp where
c391a81f 187it is 1 so that regions are commented with two or three semi-colons.")
2ab98065 188
2ab98065 189(defconst comment-styles
ee9355dc
SM
190 '((plain nil nil nil nil
191 "Start in column 0 (do not indent), as in Emacs-20")
192 (indent-or-triple nil nil nil multi-char
193 "Start in column 0, but only for single-char starters")
194 (indent nil nil nil t
195 "Full comment per line, ends not aligned")
196 (aligned nil t nil t
197 "Full comment per line, ends aligned")
198 (box nil t t t
199 "Full comment per line, ends aligned, + top and bottom")
200 (extra-line t nil t t
201 "One comment for all lines, end on a line by itself")
202 (multi-line t nil nil t
203 "One comment for all lines, end on last commented line")
204 (box-multi t t t t
205 "One comment for all lines, + top and bottom"))
206 "Comment region style definitions.
207Each style is defined with a form (STYLE . (MULTI ALIGN EXTRA INDENT DOC)).
208DOC should succinctly describe the style.
f5215400
SM
209STYLE should be a mnemonic symbol.
210MULTI specifies that comments are allowed to span multiple lines.
ee9355dc
SM
211 e.g. in C it comments regions as
212 /* blabla
213 * bli */
214 rather than
215 /* blabla */
216 /* bli */
217 if `comment-end' is empty, this has no effect.
218
f5215400 219ALIGN specifies that the `comment-end' markers should be aligned.
ee9355dc
SM
220 e.g. in C it comments regions as
221 /* blabla */
222 /* bli */
223 rather than
224 /* blabla */
225 /* bli */
226 if `comment-end' is empty, this has no effect, unless EXTRA is also set,
227 in which case the comment gets wrapped in a box.
228
f5215400
SM
229EXTRA specifies that an extra line should be used before and after the
230 region to comment (to put the `comment-end' and `comment-start').
ee9355dc
SM
231 e.g. in C it comments regions as
232 /*
233 * blabla
234 * bli
235 */
236 rather than
237 /* blabla
238 * bli */
239 if the comment style is not multi line, this has no effect, unless ALIGN
240 is also set, in which case the comment gets wrapped in a box.
241
f5215400 242INDENT specifies that the `comment-start' markers should not be put at the
c391a81f
RS
243 left margin but at the current indentation of the region to comment.
244If INDENT is `multi-char', that means indent multi-character
245 comment starters, but not one-character comment starters.")
f5215400 246
be83ecb2 247;;;###autoload
3976387b 248(defcustom comment-style 'indent
ae2c9c21 249 "Style to be used for `comment-region'.
f5215400 250See `comment-styles' for a list of available styles."
be83ecb2 251 :type (if (boundp 'comment-styles)
ee9355dc
SM
252 `(choice
253 ,@(mapcar (lambda (s)
254 `(const :tag ,(format "%s: %s" (car s) (nth 5 s))
255 ,(car s)))
256 comment-styles))
f5307782 257 'symbol)
3976387b 258 :version "23.1"
f5307782 259 :group 'comment)
2ab98065 260
be83ecb2 261;;;###autoload
aaa448c9 262(defcustom comment-padding (purecopy " ")
f5215400
SM
263 "Padding string that `comment-region' puts between comment chars and text.
264Can also be an integer which will be automatically turned into a string
265of the corresponding number of spaces.
2ab98065
SM
266
267Extra spacing between the comment characters and the comment text
0603917d 268makes the comment easier to read. Default is 1. nil means 0."
f5307782
JB
269 :type '(choice string integer (const nil))
270 :group 'comment)
2ab98065 271
be83ecb2 272;;;###autoload
3e569d22 273(defcustom comment-multi-line nil
ae2c9c21 274 "Non-nil means `comment-indent-new-line' continues comments.
269a8f1c
LT
275That is, it inserts no new terminator or starter.
276This affects `auto-fill-mode', which is the main reason to
277customize this variable.
278
279It also affects \\[indent-new-comment-line]. However, if you want this
280behavior for explicit filling, you might as well use \\[newline-and-indent]."
f5307782
JB
281 :type 'boolean
282 :group 'comment)
3e569d22 283
6976bf99
SM
284(defcustom comment-empty-lines nil
285 "If nil, `comment-region' does not comment out empty lines.
286If t, it always comments out empty lines.
e29d96b6 287If `eol' it only comments out empty lines if comments are
6976bf99
SM
288terminated by the end of line (i.e. `comment-end' is empty)."
289 :type '(choice (const :tag "Never" nil)
290 (const :tag "Always" t)
f5307782
JB
291 (const :tag "EOl-terminated" 'eol))
292 :group 'comment)
6976bf99 293
2ab98065
SM
294;;;;
295;;;; Helpers
296;;;;
297
f5215400
SM
298(defun comment-string-strip (str beforep afterp)
299 "Strip STR of any leading (if BEFOREP) and/or trailing (if AFTERP) space."
300 (string-match (concat "\\`" (if beforep "\\s-*")
ad679e45 301 "\\(.*?\\)" (if afterp "\\s-*\n?")
2ab98065
SM
302 "\\'") str)
303 (match-string 1 str))
304
305(defun comment-string-reverse (s)
f5215400 306 "Return the mirror image of string S, without any trailing space."
771c9b97 307 (comment-string-strip (concat (nreverse (string-to-list s))) nil t))
2ab98065 308
7164ef13 309;;;###autoload
2ab98065 310(defun comment-normalize-vars (&optional noerror)
0f21c5a0
SM
311 "Check and setup the variables needed by other commenting functions.
312Functions autoloaded from newcomment.el, being entry points, should call
313this function before any other, so the rest of the code can assume that
314the variables are properly set."
0d6a08f6
SM
315 (unless (and (not comment-start) noerror)
316 (unless comment-start
31df2900
SM
317 (let ((cs (read-string "No comment syntax is defined. Use: ")))
318 (if (zerop (length cs))
319 (error "No comment syntax defined")
320 (set (make-local-variable 'comment-start) cs))))
2ab98065 321 ;; comment-use-syntax
771c9b97 322 (when (eq comment-use-syntax 'undecided)
2ab98065
SM
323 (set (make-local-variable 'comment-use-syntax)
324 (let ((st (syntax-table))
325 (cs comment-start)
326 (ce (if (string= "" comment-end) "\n" comment-end)))
771c9b97
SM
327 ;; Try to skip over a comment using forward-comment
328 ;; to see if the syntax tables properly recognize it.
2ab98065
SM
329 (with-temp-buffer
330 (set-syntax-table st)
331 (insert cs " hello " ce)
332 (goto-char (point-min))
333 (and (forward-comment 1) (eobp))))))
2ab98065 334 ;; comment-padding
9145f1c2 335 (unless comment-padding (setq comment-padding 0))
2ab98065
SM
336 (when (integerp comment-padding)
337 (setq comment-padding (make-string comment-padding ? )))
338 ;; comment markers
339 ;;(setq comment-start (comment-string-strip comment-start t nil))
340 ;;(setq comment-end (comment-string-strip comment-end nil t))
341 ;; comment-continue
f5215400 342 (unless (or comment-continue (string= comment-end ""))
2ab98065 343 (set (make-local-variable 'comment-continue)
9b0d1d6e 344 (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
7164ef13
SM
345 (substring comment-start 1)))
346 ;; Hasn't been necessary yet.
347 ;; (unless (string-match comment-start-skip comment-continue)
016c63b6 348 ;; (kill-local-variable 'comment-continue))
7164ef13 349 )
2ab98065 350 ;; comment-skip regexps
f23a0f3a
SM
351 (unless (and comment-start-skip
352 ;; In case comment-start has changed since last time.
353 (string-match comment-start-skip comment-start))
2ab98065 354 (set (make-local-variable 'comment-start-skip)
f0a478be 355 (concat "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
2ab98065 356 (regexp-quote (comment-string-strip comment-start t t))
75ed43a6
SM
357 ;; Let's not allow any \s- but only [ \t] since \n
358 ;; might be both a comment-end marker and \s-.
359 "+\\)[ \t]*")))
f23a0f3a
SM
360 (unless (and comment-end-skip
361 ;; In case comment-end has changed since last time.
c9805d23
SM
362 (string-match comment-end-skip
363 (if (string= "" comment-end) "\n" comment-end)))
2ab98065
SM
364 (let ((ce (if (string= "" comment-end) "\n"
365 (comment-string-strip comment-end t t))))
366 (set (make-local-variable 'comment-end-skip)
37dbd369
SM
367 ;; We use [ \t] rather than \s- because we don't want to
368 ;; remove ^L in C mode when uncommenting.
369 (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
2ab98065 370 "\\|" (regexp-quote (substring ce 0 1))
771c9b97 371 (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
2ab98065
SM
372 (regexp-quote (substring ce 1))
373 "\\)"))))))
f1180544 374
f5215400
SM
375(defun comment-quote-re (str unp)
376 (concat (regexp-quote (substring str 0 1))
377 "\\\\" (if unp "+" "*")
378 (regexp-quote (substring str 1))))
379
380(defun comment-quote-nested (cs ce unp)
381 "Quote or unquote nested comments.
382If UNP is non-nil, unquote nested comment markers."
383 (setq cs (comment-string-strip cs t t))
384 (setq ce (comment-string-strip ce t t))
385 (when (and comment-quote-nested (> (length ce) 0))
386 (let ((re (concat (comment-quote-re ce unp)
387 "\\|" (comment-quote-re cs unp))))
388 (goto-char (point-min))
389 (while (re-search-forward re nil t)
390 (goto-char (match-beginning 0))
391 (forward-char 1)
392 (if unp (delete-char 1) (insert "\\"))
393 (when (= (length ce) 1)
394 ;; If the comment-end is a single char, adding a \ after that
395 ;; "first" char won't deactivate it, so we turn such a CE
396 ;; into !CS. I.e. for pascal, we turn } into !{
397 (if (not unp)
398 (when (string= (match-string 0) ce)
399 (replace-match (concat "!" cs) t t))
400 (when (and (< (point-min) (match-beginning 0))
401 (string= (buffer-substring (1- (match-beginning 0))
402 (1- (match-end 0)))
403 (concat "!" cs)))
404 (backward-char 2)
405 (delete-char (- (match-end 0) (match-beginning 0)))
406 (insert ce))))))))
2ab98065
SM
407
408;;;;
409;;;; Navigation
410;;;;
411
f5f95edf
SM
412(defvar comment-use-global-state nil
413 "Non-nil means that the global syntactic context is used.
414More specifically, it means that `syntax-ppss' is used to find out whether
415point is within a string or not. Major modes whose syntax is faithfully
416described by the syntax-tables can set this to non-nil so comment markers
417in strings will not confuse Emacs.")
418
ad679e45 419(defun comment-search-forward (limit &optional noerror)
771c9b97
SM
420 "Find a comment start between point and LIMIT.
421Moves point to inside the comment and returns the position of the
422comment-starter. If no comment is found, moves point to LIMIT
11a26e05 423and raises an error or returns nil if NOERROR is non-nil."
2ab98065 424 (if (not comment-use-syntax)
9b0d1d6e
SM
425 (if (re-search-forward comment-start-skip limit noerror)
426 (or (match-end 1) (match-beginning 0))
427 (goto-char limit)
428 (unless noerror (error "No comment")))
ad679e45
SM
429 (let* ((pt (point))
430 ;; Assume (at first) that pt is outside of any string.
f5f95edf
SM
431 (s (parse-partial-sexp pt (or limit (point-max)) nil nil
432 (if comment-use-global-state (syntax-ppss pt))
433 t)))
434 (when (and (nth 8 s) (nth 3 s) (not comment-use-global-state))
b70dd952
SM
435 ;; The search ended at eol inside a string. Try to see if it
436 ;; works better when we assume that pt is inside a string.
437 (setq s (parse-partial-sexp
438 pt (or limit (point-max)) nil nil
439 (list nil nil nil (nth 3 s) nil nil nil nil)
440 t)))
5605893d
SM
441 (if (or (not (and (nth 8 s) (not (nth 3 s))))
442 ;; Make sure the comment starts after PT.
443 (< (nth 8 s) pt))
ad679e45
SM
444 (unless noerror (error "No comment"))
445 ;; We found the comment.
9b0d1d6e 446 (let ((pos (point))
ad679e45 447 (start (nth 8 s))
9b0d1d6e 448 (bol (line-beginning-position))
ad679e45
SM
449 (end nil))
450 (while (and (null end) (>= (point) bol))
451 (if (looking-at comment-start-skip)
452 (setq end (min (or limit (point-max)) (match-end 0)))
453 (backward-char)))
9b0d1d6e 454 (goto-char (or end pos))
ad679e45 455 start)))))
2ab98065
SM
456
457(defun comment-search-backward (&optional limit noerror)
458 "Find a comment start between LIMIT and point.
771c9b97
SM
459Moves point to inside the comment and returns the position of the
460comment-starter. If no comment is found, moves point to LIMIT
11a26e05 461and raises an error or returns nil if NOERROR is non-nil."
ad679e45
SM
462 ;; FIXME: If a comment-start appears inside a comment, we may erroneously
463 ;; stop there. This can be rather bad in general, but since
464 ;; comment-search-backward is only used to find the comment-column (in
465 ;; comment-set-column) and to find the comment-start string (via
466 ;; comment-beginning) in indent-new-comment-line, it should be harmless.
2ab98065
SM
467 (if (not (re-search-backward comment-start-skip limit t))
468 (unless noerror (error "No comment"))
469 (beginning-of-line)
470 (let* ((end (match-end 0))
471 (cs (comment-search-forward end t))
472 (pt (point)))
473 (if (not cs)
474 (progn (beginning-of-line)
475 (comment-search-backward limit noerror))
476 (while (progn (goto-char cs)
477 (comment-forward)
478 (and (< (point) end)
479 (setq cs (comment-search-forward end t))))
480 (setq pt (point)))
481 (goto-char pt)
482 cs))))
483
484(defun comment-beginning ()
771c9b97
SM
485 "Find the beginning of the enclosing comment.
486Returns nil if not inside a comment, else moves point and returns
2308f447 487the same as `comment-search-backward'."
75ed43a6
SM
488 ;; HACK ATTACK!
489 ;; We should really test `in-string-p' but that can be expensive.
490 (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
491 (let ((pt (point))
492 (cs (comment-search-backward nil t)))
493 (when cs
494 (if (save-excursion
495 (goto-char cs)
dde6824c
SM
496 (and
497 ;; For modes where comment-start and comment-end are the same,
498 ;; the search above may have found a `ce' rather than a `cs'.
2308f447 499 (or (if comment-end-skip (not (looking-at comment-end-skip)))
dde6824c
SM
500 ;; Maybe font-lock knows that it's a `cs'?
501 (eq (get-text-property (match-end 0) 'face)
502 'font-lock-comment-face)
503 (unless (eq (get-text-property (point) 'face)
504 'font-lock-comment-face)
505 ;; Let's assume it's a `cs' if we're on the same line.
506 (>= (line-end-position) pt)))
507 ;; Make sure that PT is not past the end of the comment.
508 (if (comment-forward 1) (> (point) pt) (eobp))))
75ed43a6
SM
509 cs
510 (goto-char pt)
511 nil)))))
2ab98065
SM
512
513(defun comment-forward (&optional n)
514 "Skip forward over N comments.
515Just like `forward-comment' but only for positive N
516and can use regexps instead of syntax."
517 (setq n (or n 1))
518 (if (< n 0) (error "No comment-backward")
519 (if comment-use-syntax (forward-comment n)
520 (while (> n 0)
59a1ce8d 521 (setq n
0f38a885
SM
522 (if (or (forward-comment 1)
523 (and (looking-at comment-start-skip)
524 (goto-char (match-end 0))
525 (re-search-forward comment-end-skip nil 'move)))
59a1ce8d 526 (1- n) -1)))
2ab98065
SM
527 (= n 0))))
528
529(defun comment-enter-backward ()
530 "Move from the end of a comment to the end of its content.
771c9b97 531Point is assumed to be just at the end of a comment."
2ab98065
SM
532 (if (bolp)
533 ;; comment-end = ""
534 (progn (backward-char) (skip-syntax-backward " "))
3cc4b076 535 (cond
33d71ec3
SM
536 ((save-excursion
537 (save-restriction
538 (narrow-to-region (line-beginning-position) (point))
539 (goto-char (point-min))
540 (re-search-forward (concat comment-end-skip "\\'") nil t)))
3cc4b076 541 (goto-char (match-beginning 0)))
2ed8e1f7
SM
542 ;; comment-end-skip not found probably because it was not set
543 ;; right. Since \\s> should catch the single-char case, let's
544 ;; check that we're looking at a two-char comment ender.
545 ((not (or (<= (- (point-max) (line-beginning-position)) 1)
546 (zerop (logand (car (syntax-after (- (point) 1)))
547 ;; Here we take advantage of the fact that
548 ;; the syntax class " " is encoded to 0,
549 ;; so " 4" gives us just the 4 bit.
550 (car (string-to-syntax " 4"))))
551 (zerop (logand (car (syntax-after (- (point) 2)))
552 (car (string-to-syntax " 3"))))))
3cc4b076
SM
553 (backward-char 2)
554 (skip-chars-backward (string (char-after)))
2ed8e1f7
SM
555 (skip-syntax-backward " "))
556 ;; No clue what's going on: maybe we're really not right after the
557 ;; end of a comment. Maybe we're at the "end" because of EOB rather
558 ;; than because of a marker.
559 (t (skip-syntax-backward " ")))))
2ab98065
SM
560
561;;;;
562;;;; Commands
563;;;;
564
fae99944 565;;;###autoload
87cf8421
SM
566(defun comment-indent-default ()
567 "Default for `comment-indent-function'."
d3fcda22
SM
568 (if (and (looking-at "\\s<\\s<\\(\\s<\\)?")
569 (or (match-end 1) (/= (current-column) (current-indentation))))
570 0
87cf8421 571 (when (or (/= (current-column) (current-indentation))
8c39e595 572 (and (> comment-add 0) (looking-at "\\s<\\(\\S<\\|\\'\\)")))
87cf8421
SM
573 comment-column)))
574
2ed8e1f7
SM
575(defun comment-choose-indent (&optional indent)
576 "Choose the indentation to use for a right-hand-side comment.
577The criteria are (in this order):
578- try to keep the comment's text within `comment-fill-column'.
579- try to align with surrounding comments.
580- prefer INDENT (or `comment-column' if nil).
581Point is expected to be at the start of the comment."
582 (unless indent (setq indent comment-column))
583 ;; Avoid moving comments past the fill-column.
584 (let ((max (+ (current-column)
585 (- (or comment-fill-column fill-column)
586 (save-excursion (end-of-line) (current-column)))))
587 (other nil)
588 (min (save-excursion (skip-chars-backward " \t")
589 (1+ (current-column)))))
590 ;; Fix up the range.
591 (if (< max min) (setq max min))
592 ;; Don't move past the fill column.
593 (if (<= max indent) (setq indent max))
594 ;; We can choose anywhere between min..max.
595 ;; Let's try to align to a comment on the previous line.
596 (save-excursion
597 (when (and (zerop (forward-line -1))
598 (setq other (comment-search-forward
599 (line-end-position) t)))
600 (goto-char other) (setq other (current-column))))
601 (if (and other (<= other max) (>= other min))
602 ;; There is a comment and it's in the range: bingo!
603 other
604 ;; Can't align to a previous comment: let's try to align to comments
605 ;; on the following lines, then. These have not been re-indented yet,
606 ;; so we can't directly align ourselves with them. All we do is to try
607 ;; and choose an indentation point with which they will be able to
608 ;; align themselves.
609 (save-excursion
610 (while (and (zerop (forward-line 1))
611 (setq other (comment-search-forward
612 (line-end-position) t)))
613 (goto-char other)
614 (let ((omax (+ (current-column)
615 (- (or comment-fill-column fill-column)
616 (save-excursion (end-of-line) (current-column)))))
617 (omin (save-excursion (skip-chars-backward " \t")
618 (1+ (current-column)))))
619 (if (and (>= omax min) (<= omin max))
620 (progn (setq min (max omin min))
621 (setq max (min omax max)))
622 ;; Can't align with this anyway, so exit the loop.
623 (goto-char (point-max))))))
624 ;; Return the closest point to indent within min..max.
625 (max min (min max indent)))))
626
be83ecb2 627;;;###autoload
3e569d22 628(defun comment-indent (&optional continue)
a71b3805 629 "Indent this line's comment to `comment-column', or insert an empty comment.
dde6824c 630If CONTINUE is non-nil, use the `comment-continue' markers if any."
83b96b22 631 (interactive "*")
ad679e45 632 (comment-normalize-vars)
83b96b22
SM
633 (let* ((empty (save-excursion (beginning-of-line)
634 (looking-at "[ \t]*$")))
f5215400 635 (starter (or (and continue comment-continue)
2ab98065 636 (and empty block-comment-start) comment-start))
f5215400 637 (ender (or (and continue comment-continue "")
2ab98065 638 (and empty block-comment-end) comment-end)))
2e1fbba4
SM
639 (unless starter (error "No comment syntax defined"))
640 (beginning-of-line)
641 (let* ((eolpos (line-end-position))
642 (begpos (comment-search-forward eolpos t))
643 cpos indent)
b9b4d12c
GM
644 (if (and comment-insert-comment-function (not begpos))
645 ;; If no comment and c-i-c-f is set, let it do everything.
646 (funcall comment-insert-comment-function)
647 ;; An existing comment?
648 (if begpos
649 (progn
650 (if (and (not (looking-at "[\t\n ]"))
651 (looking-at comment-end-skip))
652 ;; The comment is empty and we have skipped all its space
653 ;; and landed right before the comment-ender:
654 ;; Go back to the middle of the space.
655 (forward-char (/ (skip-chars-backward " \t") -2)))
656 (setq cpos (point-marker)))
2e1fbba4
SM
657 ;; If none, insert one.
658 (save-excursion
a71b3805
EZ
659 ;; Some `comment-indent-function's insist on not moving
660 ;; comments that are in column 0, so we first go to the
661 ;; likely target column.
567e961e 662 (indent-to comment-column)
e6bba95e
DL
663 ;; Ensure there's a space before the comment for things
664 ;; like sh where it matters (as well as being neater).
7c0bbe7f
JB
665 (unless (memq (char-before) '(nil ?\n ?\t ?\s))
666 (insert ?\s))
07f10bab 667 (setq begpos (point))
bb304a7a 668 (insert starter)
2e1fbba4 669 (setq cpos (point-marker))
b9b4d12c
GM
670 (insert ender)))
671 (goto-char begpos)
672 ;; Compute desired indent.
673 (setq indent (save-excursion (funcall comment-indent-function)))
674 ;; If `indent' is nil and there's code before the comment, we can't
675 ;; use `indent-according-to-mode', so we default to comment-column.
676 (unless (or indent (save-excursion (skip-chars-backward " \t") (bolp)))
677 (setq indent comment-column))
678 (if (not indent)
679 ;; comment-indent-function refuses: delegate to line-indent.
680 (indent-according-to-mode)
681 ;; If the comment is at the right of code, adjust the indentation.
682 (unless (save-excursion (skip-chars-backward " \t") (bolp))
683 (setq indent (comment-choose-indent indent)))
684 ;; Update INDENT to leave at least one space
685 ;; after other nonwhite text on the line.
686 (save-excursion
687 (skip-chars-backward " \t")
688 (unless (bolp)
689 (setq indent (max indent (1+ (current-column))))))
690 ;; If that's different from comment's current position, change it.
691 (unless (= (current-column) indent)
692 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
693 (indent-to indent)))
694 (goto-char cpos)
695 (set-marker cpos nil)))))
83b96b22 696
be83ecb2 697;;;###autoload
3e569d22 698(defun comment-set-column (arg)
83b96b22 699 "Set the comment column based on point.
2ab98065 700With no ARG, set the comment column to the current column.
83b96b22
SM
701With just minus as arg, kill any comment on this line.
702With any other arg, set comment column to indentation of the previous comment
703 and then align or create a comment on this line at that column."
704 (interactive "P")
e8fe7d39 705 (cond
ad679e45 706 ((eq arg '-) (comment-kill nil))
e8fe7d39 707 (arg
2abd0306 708 (comment-normalize-vars)
e8fe7d39
SM
709 (save-excursion
710 (beginning-of-line)
2ab98065 711 (comment-search-backward)
e8fe7d39 712 (beginning-of-line)
ad679e45 713 (goto-char (comment-search-forward (line-end-position)))
83b96b22 714 (setq comment-column (current-column))
e8fe7d39 715 (message "Comment column set to %d" comment-column))
ad679e45 716 (comment-indent))
e8fe7d39 717 (t (setq comment-column (current-column))
83b96b22
SM
718 (message "Comment column set to %d" comment-column))))
719
be83ecb2 720;;;###autoload
3e569d22 721(defun comment-kill (arg)
bbcedd05 722 "Kill the first comment on this line, if any.
7a0a180a
SM
723With prefix ARG, kill comments on that many lines starting with this one."
724 (interactive "P")
2abd0306 725 (comment-normalize-vars)
ad679e45
SM
726 (dotimes (_ (prefix-numeric-value arg))
727 (save-excursion
728 (beginning-of-line)
729 (let ((cs (comment-search-forward (line-end-position) t)))
730 (when cs
731 (goto-char cs)
732 (skip-syntax-backward " ")
733 (setq cs (point))
734 (comment-forward)
735 (kill-region cs (if (bolp) (1- (point)) (point)))
736 (indent-according-to-mode))))
737 (if arg (forward-line 1))))
7a0a180a 738
2ab98065
SM
739(defun comment-padright (str &optional n)
740 "Construct a string composed of STR plus `comment-padding'.
f5215400 741It also adds N copies of the last non-whitespace chars of STR.
2ab98065 742If STR already contains padding, the corresponding amount is
f5215400
SM
743ignored from `comment-padding'.
744N defaults to 0.
771c9b97 745If N is `re', a regexp is returned instead, that would match
f5215400 746the string for any N."
2ab98065
SM
747 (setq n (or n 0))
748 (when (and (stringp str) (not (string= "" str)))
f5215400 749 ;; Separate the actual string from any leading/trailing padding
3e569d22 750 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
f5215400
SM
751 (let ((s (match-string 1 str)) ;actual string
752 (lpad (substring str 0 (match-beginning 1))) ;left padding
753 (rpad (concat (substring str (match-end 1)) ;original right padding
754 (substring comment-padding ;additional right padding
3e569d22 755 (min (- (match-end 0) (match-end 1))
9b0d1d6e
SM
756 (length comment-padding)))))
757 ;; We can only duplicate C if the comment-end has multiple chars
758 ;; or if comments can be nested, else the comment-end `}' would
759 ;; be turned into `}}}' where only the first ends the comment
760 ;; and the rest becomes bogus junk.
761 (multi (not (and comment-quote-nested
762 ;; comment-end is a single char
763 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
f5215400 764 (if (not (symbolp n))
9b0d1d6e 765 (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
f5215400
SM
766 ;; construct a regexp that would match anything from just S
767 ;; to any possible output of this function for any N.
768 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
769 lpad "") ;padding is not required
9b0d1d6e
SM
770 (regexp-quote s)
771 (when multi "+") ;the last char of S might be repeated
f5215400
SM
772 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
773 rpad "")))))) ;padding is not required
2ab98065
SM
774
775(defun comment-padleft (str &optional n)
776 "Construct a string composed of `comment-padding' plus STR.
f5215400 777It also adds N copies of the first non-whitespace chars of STR.
2ab98065 778If STR already contains padding, the corresponding amount is
f5215400
SM
779ignored from `comment-padding'.
780N defaults to 0.
771c9b97 781If N is `re', a regexp is returned instead, that would match
2ab98065
SM
782 the string for any N."
783 (setq n (or n 0))
784 (when (and (stringp str) (not (string= "" str)))
f5215400 785 ;; Only separate the left pad because we assume there is no right pad.
2ab98065
SM
786 (string-match "\\`\\s-*" str)
787 (let ((s (substring str (match-end 0)))
788 (pad (concat (substring comment-padding
789 (min (- (match-end 0) (match-beginning 0))
790 (length comment-padding)))
791 (match-string 0 str)))
f5215400
SM
792 (c (aref str (match-end 0))) ;the first non-space char of STR
793 ;; We can only duplicate C if the comment-end has multiple chars
794 ;; or if comments can be nested, else the comment-end `}' would
795 ;; be turned into `}}}' where only the first ends the comment
796 ;; and the rest becomes bogus junk.
797 (multi (not (and comment-quote-nested
798 ;; comment-end is a single char
799 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
800 (if (not (symbolp n))
801 (concat pad (when multi (make-string n c)) s)
802 ;; Construct a regexp that would match anything from just S
803 ;; to any possible output of this function for any N.
804 ;; We match any number of leading spaces because this regexp will
805 ;; be used for uncommenting where we might want to remove
806 ;; uncomment markers with arbitrary leading space (because
807 ;; they were aligned).
808 (concat "\\s-*"
809 (if multi (concat (regexp-quote (string c)) "*"))
810 (regexp-quote s))))))
83b96b22 811
be83ecb2 812;;;###autoload
7a0a180a 813(defun uncomment-region (beg end &optional arg)
eb0b51f8 814 "Uncomment each line in the BEG .. END region.
f5215400
SM
815The numeric prefix ARG can specify a number of chars to remove from the
816comment markers."
83b96b22
SM
817 (interactive "*r\nP")
818 (comment-normalize-vars)
065b7364 819 (when (> beg end) (setq beg (prog1 end (setq end beg))))
b70dd952
SM
820 ;; Bind `comment-use-global-state' to nil. While uncommenting a region
821 ;; (which works a line at a time), a comment can appear to be
cbdad6e2
EZ
822 ;; included in a mult-line string, but it is actually not.
823 (let ((comment-use-global-state nil))
824 (save-excursion
b70dd952
SM
825 (funcall uncomment-region-function beg end arg))))
826
827(defun uncomment-region-default (beg end &optional arg)
828 "Uncomment each line in the BEG .. END region.
829The numeric prefix ARG can specify a number of chars to remove from the
830comment markers."
831 (goto-char beg)
832 (setq end (copy-marker end))
833 (let* ((numarg (prefix-numeric-value arg))
834 (ccs comment-continue)
835 (srei (comment-padright ccs 're))
836 (csre (comment-padright comment-start 're))
837 (sre (and srei (concat "^\\s-*?\\(" srei "\\)")))
838 spt)
839 (while (and (< (point) end)
840 (setq spt (comment-search-forward end t)))
841 (let ((ipt (point))
842 ;; Find the end of the comment.
843 (ept (progn
844 (goto-char spt)
845 (unless (or (comment-forward)
846 ;; Allow non-terminated comments.
847 (eobp))
848 (error "Can't find the comment end"))
849 (point)))
850 (box nil)
851 (box-equal nil)) ;Whether we might be using `=' for boxes.
852 (save-restriction
853 (narrow-to-region spt ept)
016c63b6 854
b70dd952
SM
855 ;; Remove the comment-start.
856 (goto-char ipt)
857 (skip-syntax-backward " ")
858 ;; A box-comment starts with a looong comment-start marker.
859 (when (and (or (and (= (- (point) (point-min)) 1)
860 (setq box-equal t)
861 (looking-at "=\\{7\\}")
862 (not (eq (char-before (point-max)) ?\n))
863 (skip-chars-forward "="))
864 (> (- (point) (point-min) (length comment-start)) 7))
865 (> (count-lines (point-min) (point-max)) 2))
866 (setq box t))
867 ;; Skip the padding. Padding can come from comment-padding and/or
868 ;; from comment-start, so we first check comment-start.
869 (if (or (save-excursion (goto-char (point-min)) (looking-at csre))
870 (looking-at (regexp-quote comment-padding)))
871 (goto-char (match-end 0)))
872 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
873 (goto-char (match-end 0)))
874 (if (null arg) (delete-region (point-min) (point))
875 (skip-syntax-backward " ")
876 (delete-char (- numarg))
877 (unless (or (bobp)
878 (save-excursion (goto-char (point-min))
879 (looking-at comment-start-skip)))
880 ;; If there's something left but it doesn't look like
881 ;; a comment-start any more, just remove it.
882 (delete-region (point-min) (point))))
016c63b6 883
b70dd952
SM
884 ;; Remove the end-comment (and leading padding and such).
885 (goto-char (point-max)) (comment-enter-backward)
886 ;; Check for special `=' used sometimes in comment-box.
887 (when (and box-equal (not (eq (char-before (point-max)) ?\n)))
888 (let ((pos (point)))
889 ;; skip `=' but only if there are at least 7.
890 (when (> (skip-chars-backward "=") -7) (goto-char pos))))
891 (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
892 (when (and (bolp) (not (bobp))) (backward-char))
893 (if (null arg) (delete-region (point) (point-max))
894 (skip-syntax-forward " ")
895 (delete-char numarg)
896 (unless (or (eobp) (looking-at comment-end-skip))
897 ;; If there's something left but it doesn't look like
898 ;; a comment-end any more, just remove it.
899 (delete-region (point) (point-max)))))
900
901 ;; Unquote any nested end-comment.
902 (comment-quote-nested comment-start comment-end t)
903
904 ;; Eliminate continuation markers as well.
905 (when sre
906 (let* ((cce (comment-string-reverse (or comment-continue
907 comment-start)))
908 (erei (and box (comment-padleft cce 're)))
909 (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))
910 (goto-char (point-min))
911 (while (progn
912 (if (and ere (re-search-forward
913 ere (line-end-position) t))
914 (replace-match "" t t nil (if (match-end 2) 2 1))
915 (setq ere nil))
916 (forward-line 1)
917 (re-search-forward sre (line-end-position) t))
918 (replace-match "" t t nil (if (match-end 2) 2 1)))))
919 ;; Go to the end for the next comment.
920 (goto-char (point-max))))))
921 (set-marker end nil))
83b96b22 922
aac88001 923(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
ad679e45
SM
924 "Make the leading and trailing extra lines.
925This is used for `extra-line' style (or `box' style if BLOCK is specified)."
9b0d1d6e
SM
926 (let ((eindent 0))
927 (if (not block)
928 ;; Try to match CS and CE's content so they align aesthetically.
929 (progn
930 (setq ce (comment-string-strip ce t t))
931 (when (string-match "\\(.+\\).*\n\\(.*?\\)\\1" (concat ce "\n" cs))
932 (setq eindent
933 (max (- (match-end 2) (match-beginning 2) (match-beginning 0))
934 0))))
935 ;; box comment
936 (let* ((width (- max-indent min-indent))
937 (s (concat cs "a=m" cce))
938 (e (concat ccs "a=m" ce))
939 (c (if (string-match ".*\\S-\\S-" cs)
3674a4a9
SM
940 (aref cs (1- (match-end 0)))
941 (if (and (equal comment-end "") (string-match ".*\\S-" cs))
942 (aref cs (1- (match-end 0))) ?=)))
943 (re "\\s-*a=m\\s-*")
944 (_ (string-match re s))
945 (lcs (length cs))
9b0d1d6e
SM
946 (fill
947 (make-string (+ width (- (match-end 0)
3674a4a9 948 (match-beginning 0) lcs 3)) c)))
aac88001 949 (setq cs (replace-match fill t t s))
3674a4a9
SM
950 (when (and (not (string-match comment-start-skip cs))
951 (string-match "a=m" s))
952 ;; The whitespace around CS cannot be ignored: put it back.
953 (setq re "a=m")
954 (setq fill (make-string (- width lcs) c))
955 (setq cs (replace-match fill t t s)))
956 (string-match re e)
9b0d1d6e
SM
957 (setq ce (replace-match fill t t e))))
958 (cons (concat cs "\n" (make-string min-indent ? ) ccs)
959 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce))))
aac88001 960
aac88001
SM
961(defmacro comment-with-narrowing (beg end &rest body)
962 "Execute BODY with BEG..END narrowing.
963Space is added (and then removed) at the beginning for the text's
964indentation to be kept as it was before narrowing."
4745e738 965 (declare (debug t) (indent 2))
59a1ce8d 966 (let ((bindent (make-symbol "bindent")))
bfe6e13f 967 `(let ((,bindent (save-excursion (goto-char ,beg) (current-column))))
59a1ce8d 968 (save-restriction
bfe6e13f 969 (narrow-to-region ,beg ,end)
59a1ce8d
SM
970 (goto-char (point-min))
971 (insert (make-string ,bindent ? ))
972 (prog1
973 (progn ,@body)
974 ;; remove the bindent
975 (save-excursion
976 (goto-char (point-min))
977 (when (looking-at " *")
978 (let ((n (min (- (match-end 0) (match-beginning 0)) ,bindent)))
aac88001 979 (delete-char n)
59a1ce8d
SM
980 (setq ,bindent (- ,bindent n))))
981 (end-of-line)
982 (let ((e (point)))
983 (beginning-of-line)
984 (while (and (> ,bindent 0) (re-search-forward " *" e t))
985 (let ((n (min ,bindent (- (match-end 0) (match-beginning 0) 1))))
986 (goto-char (match-beginning 0))
987 (delete-char n)
988 (setq ,bindent (- ,bindent n)))))))))))
aac88001 989
c391a81f 990(defun comment-add (arg)
f0b7054e
SM
991 "Compute the number of extra comment starter characters
992\(extra semicolons in Lisp mode, extra stars in C mode, etc.)
993If ARG is non-nil, just follow ARG.
994If the comment starter is multi-char, just follow ARG.
995Otherwise obey `comment-add'."
b433a560 996 (if (and (null arg) (= (string-match "[ \t]*\\'" comment-start) 1))
c391a81f 997 (* comment-add 1)
b433a560
SM
998 (1- (prefix-numeric-value arg))))
999
771c9b97 1000(defun comment-region-internal (beg end cs ce
aa417798 1001 &optional ccs cce block lines indent)
3674a4a9 1002 "Comment region BEG .. END.
aa417798
JB
1003CS and CE are the comment start string and comment end string,
1004respectively. CCS and CCE are the comment continuation strings
1005for the start and end of lines, respectively (default to CS and CE).
1006BLOCK indicates that end of lines should be marked with either CCE,
1007CE or CS \(if CE is empty) and that those markers should be aligned.
1008LINES indicates that an extra lines will be used at the beginning
1009and end of the region for CE and CS.
1010INDENT indicates to put CS and CCS at the current indentation of
1011the region rather than at left margin."
59a1ce8d 1012 ;;(assert (< beg end))
6976bf99 1013 (let ((no-empty (not (or (eq comment-empty-lines t)
53dd1d53
GM
1014 (and comment-empty-lines (zerop (length ce))))))
1015 ce-sanitized)
f5215400 1016 ;; Sanitize CE and CCE.
83b96b22 1017 (if (and (stringp ce) (string= "" ce)) (setq ce nil))
53dd1d53 1018 (setq ce-sanitized ce)
83b96b22 1019 (if (and (stringp cce) (string= "" cce)) (setq cce nil))
f5215400
SM
1020 ;; If CE is empty, multiline cannot be used.
1021 (unless ce (setq ccs nil cce nil))
1022 ;; Should we mark empty lines as well ?
83b96b22 1023 (if (or ccs block lines) (setq no-empty nil))
f5215400 1024 ;; Make sure we have end-markers for BLOCK mode.
2ab98065 1025 (when block (unless ce (setq ce (comment-string-reverse cs))))
f5215400
SM
1026 ;; If BLOCK is not requested, we don't need CCE.
1027 (unless block (setq cce nil))
1028 ;; Continuation defaults to the same as CS and CE.
1029 (unless ccs (setq ccs cs cce ce))
f1180544 1030
83b96b22 1031 (save-excursion
aac88001 1032 (goto-char end)
f5215400
SM
1033 ;; If the end is not at the end of a line and the comment-end
1034 ;; is implicit (i.e. a newline), explicitly insert a newline.
53dd1d53 1035 (unless (or ce-sanitized (eolp)) (insert "\n") (indent-according-to-mode))
aac88001 1036 (comment-with-narrowing beg end
f5215400 1037 (let ((min-indent (point-max))
9d5240d2 1038 (max-indent 0))
83b96b22 1039 (goto-char (point-min))
f5215400
SM
1040 ;; Quote any nested comment marker
1041 (comment-quote-nested comment-start comment-end nil)
1042
1043 ;; Loop over all lines to find the needed indentations.
4125ec7e 1044 (goto-char (point-min))
f5215400
SM
1045 (while
1046 (progn
1047 (unless (looking-at "[ \t]*$")
1048 (setq min-indent (min min-indent (current-indentation))))
1049 (end-of-line)
1050 (setq max-indent (max max-indent (current-column)))
1051 (not (or (eobp) (progn (forward-line) nil)))))
f1180544 1052
59a1ce8d 1053 (setq max-indent
45f6a663
SM
1054 (+ max-indent (max (length cs) (length ccs))
1055 ;; Inserting ccs can change max-indent by (1- tab-width)
1056 ;; but only if there are TABs in the boxed text, of course.
1057 (if (save-excursion (goto-char beg)
1058 (search-forward "\t" end t))
1059 (1- tab-width) 0)))
771c9b97 1060 (unless indent (setq min-indent 0))
83b96b22 1061
aac88001 1062 ;; make the leading and trailing lines if requested
83b96b22 1063 (when lines
771c9b97
SM
1064 (let ((csce
1065 (comment-make-extra-lines
1066 cs ce ccs cce min-indent max-indent block)))
1067 (setq cs (car csce))
1068 (setq ce (cdr csce))))
f1180544 1069
83b96b22
SM
1070 (goto-char (point-min))
1071 ;; Loop over all lines from BEG to END.
f5215400
SM
1072 (while
1073 (progn
1074 (unless (and no-empty (looking-at "[ \t]*$"))
1075 (move-to-column min-indent t)
1076 (insert cs) (setq cs ccs) ;switch to CCS after the first line
1077 (end-of-line)
1078 (if (eobp) (setq cce ce))
1079 (when cce
1080 (when block (move-to-column max-indent t))
1081 (insert cce)))
1082 (end-of-line)
1083 (not (or (eobp) (progn (forward-line) nil))))))))))
83b96b22 1084
be83ecb2 1085;;;###autoload
83b96b22
SM
1086(defun comment-region (beg end &optional arg)
1087 "Comment or uncomment each line in the region.
3674a4a9 1088With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END.
11a26e05 1089Numeric prefix ARG means use ARG comment characters.
83b96b22 1090If ARG is negative, delete that many comment characters instead.
83b96b22 1091
707f4689
CY
1092The strings used as comment starts are built from `comment-start'
1093and `comment-padding'; the strings used as comment ends are built
1094from `comment-end' and `comment-padding'.
1095
1096By default, the `comment-start' markers are inserted at the
1097current indentation of the region, and comments are terminated on
1098each line (even for syntaxes in which newline does not end the
1099comment and blank lines do not get comments). This can be
1100changed with `comment-style'."
83b96b22
SM
1101 (interactive "*r\nP")
1102 (comment-normalize-vars)
1103 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
b70dd952
SM
1104 (save-excursion
1105 ;; FIXME: maybe we should call uncomment depending on ARG.
1106 (funcall comment-region-function beg end arg)))
1107
1108(defun comment-region-default (beg end &optional arg)
2ab98065 1109 (let* ((numarg (prefix-numeric-value arg))
2ab98065
SM
1110 (style (cdr (assoc comment-style comment-styles)))
1111 (lines (nth 2 style))
1112 (block (nth 1 style))
1113 (multi (nth 0 style)))
5266b06b
RS
1114
1115 ;; We use `chars' instead of `syntax' because `\n' might be
b70dd952
SM
1116 ;; of end-comment syntax rather than of whitespace syntax.
1117 ;; sanitize BEG and END
1118 (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
1119 (setq beg (max beg (point)))
1120 (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
1121 (setq end (min end (point)))
1122 (if (>= beg end) (error "Nothing to comment"))
1123
1124 ;; sanitize LINES
1125 (setq lines
1126 (and
1127 lines ;; multi
1128 (progn (goto-char beg) (beginning-of-line)
1129 (skip-syntax-forward " ")
1130 (>= (point) beg))
1131 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
1132 (<= (point) end))
1133 (or block (not (string= "" comment-end)))
1134 (or block (progn (goto-char beg) (search-forward "\n" end t)))))
1135
1136 ;; don't add end-markers just because the user asked for `block'
1137 (unless (or lines (string= "" comment-end)) (setq block nil))
1138
1139 (cond
1140 ((consp arg) (uncomment-region beg end))
1141 ((< numarg 0) (uncomment-region beg end (- numarg)))
1142 (t
c391a81f 1143 (let ((multi-char (/= (string-match "[ \t]*\\'" comment-start) 1))
9f15f676 1144 indent triple)
c391a81f 1145 (if (eq (nth 3 style) 'multi-char)
9f15f676
RS
1146 (save-excursion
1147 (goto-char beg)
1148 (setq indent multi-char
1149 ;; Triple if we will put the comment starter at the margin
1150 ;; and the first line of the region isn't indented
1151 ;; at least two spaces.
1152 triple (and (not multi-char) (looking-at "\t\\| "))))
c391a81f
RS
1153 (setq indent (nth 3 style)))
1154
1155 ;; In Lisp and similar modes with one-character comment starters,
1156 ;; double it by default if `comment-add' says so.
1157 ;; If it isn't indented, triple it.
1158 (if (and (null arg) (not multi-char))
9f15f676 1159 (setq numarg (* comment-add (if triple 2 1)))
c391a81f
RS
1160 (setq numarg (1- (prefix-numeric-value arg))))
1161
1162 (comment-region-internal
1163 beg end
1164 (let ((s (comment-padright comment-start numarg)))
1165 (if (string-match comment-start-skip s) s
1166 (comment-padright comment-start)))
1167 (let ((s (comment-padleft comment-end numarg)))
1168 (and s (if (string-match comment-end-skip s) s
1169 (comment-padright comment-end))))
1170 (if multi (comment-padright comment-continue numarg))
1171 (if multi
1172 (comment-padleft (comment-string-reverse comment-continue) numarg))
1173 block
1174 lines
1175 indent))))))
771c9b97 1176
016c63b6 1177;;;###autoload
771c9b97 1178(defun comment-box (beg end &optional arg)
3674a4a9 1179 "Comment out the BEG .. END region, putting it inside a box.
771c9b97
SM
1180The numeric prefix ARG specifies how many characters to add to begin- and
1181end- comment markers additionally to what `comment-add' already specifies."
1182 (interactive "*r\np")
016c63b6 1183 (comment-normalize-vars)
9b0d1d6e
SM
1184 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
1185 'box-multi 'box)))
771c9b97 1186 (comment-region beg end (+ comment-add arg))))
83b96b22 1187
88fe06af
SM
1188
1189;;;###autoload
1190(defun comment-or-uncomment-region (beg end &optional arg)
1191 "Call `comment-region', unless the region only consists of comments,
1192in which case call `uncomment-region'. If a prefix arg is given, it
1193is passed on to the respective function."
1194 (interactive "*r\nP")
2abd0306 1195 (comment-normalize-vars)
88fe06af
SM
1196 (funcall (if (save-excursion ;; check for already commented region
1197 (goto-char beg)
1198 (comment-forward (point-max))
1199 (<= end (point)))
1200 'uncomment-region 'comment-region)
1201 beg end arg))
1202
be83ecb2 1203;;;###autoload
2ab98065 1204(defun comment-dwim (arg)
ad679e45
SM
1205 "Call the comment command you want (Do What I Mean).
1206If the region is active and `transient-mark-mode' is on, call
23737b4a
LMI
1207`comment-region' (unless it only consists of comments, in which
1208case it calls `uncomment-region').
eb0c4c30
GM
1209Else, if the current line is empty, call `comment-insert-comment-function'
1210if it is defined, otherwise insert a comment and indent it.
ad679e45 1211Else if a prefix ARG is specified, call `comment-kill'.
ae2c9c21
SM
1212Else, call `comment-indent'.
1213You can configure `comment-style' to change the way regions are commented."
2ab98065
SM
1214 (interactive "*P")
1215 (comment-normalize-vars)
771c9b97 1216 (if (and mark-active transient-mark-mode)
88fe06af 1217 (comment-or-uncomment-region (region-beginning) (region-end) arg)
2ab98065 1218 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
ad679e45
SM
1219 ;; FIXME: If there's no comment to kill on this line and ARG is
1220 ;; specified, calling comment-kill is not very clever.
1221 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent))
eb0c4c30
GM
1222 ;; Inserting a comment on a blank line. comment-indent calls
1223 ;; c-i-c-f if needed in the non-blank case.
1224 (if comment-insert-comment-function
1225 (funcall comment-insert-comment-function)
1226 (let ((add (comment-add arg)))
1227 ;; Some modes insist on keeping column 0 comment in column 0
1228 ;; so we need to move away from it before inserting the comment.
1229 (indent-according-to-mode)
1230 (insert (comment-padright comment-start add))
1231 (save-excursion
1232 (unless (string= "" comment-end)
1233 (insert (comment-padleft comment-end add)))
1234 (indent-according-to-mode)))))))
2ab98065 1235
1fc075d8 1236;;;###autoload
392f1ef5
SM
1237(defcustom comment-auto-fill-only-comments nil
1238 "Non-nil means to only auto-fill inside comments.
1239This has no effect in modes that do not define a comment syntax."
f5307782
JB
1240 :type 'boolean
1241 :group 'comment)
392f1ef5 1242
bfe6e13f 1243(defun comment-valid-prefix-p (prefix compos)
e29d96b6
SM
1244 "Check that the adaptive-fill-prefix is consistent with the context.
1245PREFIX is the prefix (presumably guessed by `adaptive-fill-mode').
1246COMPOS is the position of the beginning of the comment we're in, or nil
1247if we're not inside a comment."
1248 ;; This consistency checking is mostly needed to workaround the limitation
1249 ;; of auto-fill-mode whose paragraph-determination doesn't pay attention
1250 ;; to comment boundaries.
1251 (if (null compos)
1252 ;; We're not inside a comment: the prefix shouldn't match
1253 ;; a comment-starter.
1254 (not (and comment-start comment-start-skip
1255 (string-match comment-start-skip prefix)))
1256 (or
1257 ;; Accept any prefix if the current comment is not EOL-terminated.
1258 (save-excursion (goto-char compos) (comment-forward) (not (bolp)))
1259 ;; Accept any prefix that starts with the same comment-start marker
1260 ;; as the current one.
1261 (when (string-match (concat "\\`[ \t]*\\(?:" comment-start-skip "\\)")
1262 prefix)
1263 (let ((prefix-com (comment-string-strip (match-string 0 prefix) nil t)))
1264 (string-match "\\`[ \t]*" prefix-com)
1265 (let* ((prefix-space (match-string 0 prefix-com))
1266 (prefix-indent (string-width prefix-space))
1267 (prefix-comstart (substring prefix-com (match-end 0))))
1268 (save-excursion
1269 (goto-char compos)
1270 ;; The comstart marker is the same.
1271 (and (looking-at (regexp-quote prefix-comstart))
1272 ;; The indentation as well.
1273 (or (= prefix-indent
1274 (- (current-column) (current-left-margin)))
1275 ;; Check the indentation in two different ways, just
1276 ;; to try and avoid most of the potential funny cases.
1277 (equal prefix-space
1278 (buffer-substring (point)
1279 (progn (move-to-left-margin)
1280 (point)))))))))))))
32226619 1281
7164ef13 1282
be83ecb2 1283;;;###autoload
ad679e45 1284(defun comment-indent-new-line (&optional soft)
2ab98065
SM
1285 "Break line at point and indent, continuing comment if within one.
1286This indents the body of the continued comment
1287under the previous comment line.
1288
1289This command is intended for styles where you write a comment per line,
1290starting a new comment (and terminating it if necessary) on each line.
1291If you want to continue one comment across several lines, use \\[newline-and-indent].
1292
1293If a fill column is specified, it overrides the use of the comment column
1294or comment indentation.
1295
1296The inserted newline is marked hard if variable `use-hard-newlines' is true,
1297unless optional argument SOFT is non-nil."
1298 (interactive)
1299 (comment-normalize-vars t)
59a1ce8d
SM
1300 (let (compos comin)
1301 ;; If we are not inside a comment and we only auto-fill comments,
1302 ;; don't do anything (unless no comment syntax is defined).
392f1ef5
SM
1303 (unless (and comment-start
1304 comment-auto-fill-only-comments
32226619 1305 (not (called-interactively-p 'interactive))
392f1ef5 1306 (not (save-excursion
59a1ce8d 1307 (prog1 (setq compos (comment-beginning))
392f1ef5 1308 (setq comin (point))))))
59a1ce8d
SM
1309
1310 ;; Now we know we should auto-fill.
88fe06af
SM
1311 ;; Insert the newline before removing empty space so that markers
1312 ;; get preserved better.
392f1ef5 1313 (if soft (insert-and-inherit ?\n) (newline 1))
88fe06af
SM
1314 (save-excursion (forward-char -1) (delete-horizontal-space))
1315 (delete-horizontal-space)
1316
7164ef13
SM
1317 (if (and fill-prefix (not adaptive-fill-mode))
1318 ;; Blindly trust a non-adaptive fill-prefix.
392f1ef5
SM
1319 (progn
1320 (indent-to-left-margin)
88fe06af 1321 (insert-before-markers-and-inherit fill-prefix))
59a1ce8d
SM
1322
1323 ;; If necessary check whether we're inside a comment.
a764440a 1324 (unless (or compos (null comment-start))
392f1ef5
SM
1325 (save-excursion
1326 (backward-char)
59a1ce8d
SM
1327 (setq compos (comment-beginning))
1328 (setq comin (point))))
1329
7164ef13
SM
1330 (cond
1331 ;; If there's an adaptive prefix, use it unless we're inside
1332 ;; a comment and the prefix is not a comment starter.
1333 ((and fill-prefix
e29d96b6 1334 (comment-valid-prefix-p fill-prefix compos))
7164ef13
SM
1335 (indent-to-left-margin)
1336 (insert-and-inherit fill-prefix))
1337 ;; If we're not inside a comment, just try to indent.
1338 ((not compos) (indent-according-to-mode))
1339 (t
59a1ce8d
SM
1340 (let* ((comment-column
1341 ;; The continuation indentation should be somewhere between
1342 ;; the current line's indentation (plus 2 for good measure)
1343 ;; and the current comment's indentation, with a preference
1344 ;; for comment-column.
1345 (save-excursion
a764440a 1346 ;; FIXME: use prev line's info rather than first line's.
59a1ce8d
SM
1347 (goto-char compos)
1348 (min (current-column) (max comment-column
1349 (+ 2 (current-indentation))))))
1350 (comstart (buffer-substring compos comin))
1351 (normalp
1352 (string-match (regexp-quote (comment-string-strip
1353 comment-start t t))
1354 comstart))
1355 (comment-end
1356 (if normalp comment-end
1357 ;; The comment starter is not the normal comment-start
1358 ;; so we can't just use comment-end.
1359 (save-excursion
1360 (goto-char compos)
1361 (if (not (comment-forward)) comment-end
1362 (comment-string-strip
1363 (buffer-substring
1364 (save-excursion (comment-enter-backward) (point))
1365 (point))
1366 nil t)))))
1367 (comment-start comstart)
a764440a
SM
1368 (continuep (or comment-multi-line
1369 (cadr (assoc comment-style comment-styles))))
59a1ce8d 1370 ;; Force comment-continue to be recreated from comment-start.
dde6824c 1371 ;; FIXME: wrong if comment-continue was set explicitly!
a764440a 1372 ;; FIXME: use prev line's continuation if available.
59a1ce8d 1373 (comment-continue nil))
a764440a
SM
1374 (if (and comment-multi-line (> (length comment-end) 0))
1375 (indent-according-to-mode)
1376 (insert-and-inherit ?\n)
1377 (forward-char -1)
1378 (comment-indent continuep)
1379 (save-excursion
1380 (let ((pt (point)))
1381 (end-of-line)
1382 (let ((comend (buffer-substring pt (point))))
1383 ;; The 1+ is to make sure we delete the \n inserted above.
1384 (delete-region pt (1+ (point)))
1385 (end-of-line 0)
1386 (insert comend))))))))))))
2ab98065 1387
83b96b22
SM
1388(provide 'newcomment)
1389
b70dd952 1390;; arch-tag: 01e3320a-00c8-44ea-a696-8f8e7354c858
83b96b22 1391;;; newcomment.el ends here