(send-mail-function): Customize.
[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
c64c0551 8;; Revision: $Id: newcomment.el,v 1.28 2000/12/11 21:41:35 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))
236 "+\\)\\s-*")))
237 (unless comment-end-skip
238 (let ((ce (if (string= "" comment-end) "\n"
239 (comment-string-strip comment-end t t))))
240 (set (make-local-variable 'comment-end-skip)
771c9b97 241 (concat "\\s-*\\(\\s>" (if comment-quote-nested "" "+")
2ab98065 242 "\\|" (regexp-quote (substring ce 0 1))
771c9b97 243 (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
2ab98065
SM
244 (regexp-quote (substring ce 1))
245 "\\)"))))))
246
f5215400
SM
247(defun comment-quote-re (str unp)
248 (concat (regexp-quote (substring str 0 1))
249 "\\\\" (if unp "+" "*")
250 (regexp-quote (substring str 1))))
251
252(defun comment-quote-nested (cs ce unp)
253 "Quote or unquote nested comments.
254If UNP is non-nil, unquote nested comment markers."
255 (setq cs (comment-string-strip cs t t))
256 (setq ce (comment-string-strip ce t t))
257 (when (and comment-quote-nested (> (length ce) 0))
258 (let ((re (concat (comment-quote-re ce unp)
259 "\\|" (comment-quote-re cs unp))))
260 (goto-char (point-min))
261 (while (re-search-forward re nil t)
262 (goto-char (match-beginning 0))
263 (forward-char 1)
264 (if unp (delete-char 1) (insert "\\"))
265 (when (= (length ce) 1)
266 ;; If the comment-end is a single char, adding a \ after that
267 ;; "first" char won't deactivate it, so we turn such a CE
268 ;; into !CS. I.e. for pascal, we turn } into !{
269 (if (not unp)
270 (when (string= (match-string 0) ce)
271 (replace-match (concat "!" cs) t t))
272 (when (and (< (point-min) (match-beginning 0))
273 (string= (buffer-substring (1- (match-beginning 0))
274 (1- (match-end 0)))
275 (concat "!" cs)))
276 (backward-char 2)
277 (delete-char (- (match-end 0) (match-beginning 0)))
278 (insert ce))))))))
2ab98065
SM
279
280;;;;
281;;;; Navigation
282;;;;
283
ad679e45 284(defun comment-search-forward (limit &optional noerror)
771c9b97
SM
285 "Find a comment start between point and LIMIT.
286Moves point to inside the comment and returns the position of the
287comment-starter. If no comment is found, moves point to LIMIT
e8fe7d39 288and raises an error or returns nil of NOERROR is non-nil."
2ab98065 289 (if (not comment-use-syntax)
9b0d1d6e
SM
290 (if (re-search-forward comment-start-skip limit noerror)
291 (or (match-end 1) (match-beginning 0))
292 (goto-char limit)
293 (unless noerror (error "No comment")))
ad679e45
SM
294 (let* ((pt (point))
295 ;; Assume (at first) that pt is outside of any string.
296 (s (parse-partial-sexp pt (or limit (point-max)) nil nil nil t)))
297 (when (and (nth 8 s) (nth 3 s))
298 ;; The search ended inside a string. Try to see if it
299 ;; works better when we assume that pt is inside a string.
300 (setq s (parse-partial-sexp
301 pt (or limit (point-max)) nil nil
302 (list nil nil nil (nth 3 s) nil nil nil nil)
303 t)))
304 (if (not (and (nth 8 s) (not (nth 3 s))))
305 (unless noerror (error "No comment"))
306 ;; We found the comment.
9b0d1d6e 307 (let ((pos (point))
ad679e45 308 (start (nth 8 s))
9b0d1d6e 309 (bol (line-beginning-position))
ad679e45
SM
310 (end nil))
311 (while (and (null end) (>= (point) bol))
312 (if (looking-at comment-start-skip)
313 (setq end (min (or limit (point-max)) (match-end 0)))
314 (backward-char)))
9b0d1d6e 315 (goto-char (or end pos))
ad679e45 316 start)))))
2ab98065
SM
317
318(defun comment-search-backward (&optional limit noerror)
319 "Find a comment start between LIMIT and point.
771c9b97
SM
320Moves point to inside the comment and returns the position of the
321comment-starter. If no comment is found, moves point to LIMIT
2ab98065 322and raises an error or returns nil of NOERROR is non-nil."
ad679e45
SM
323 ;; FIXME: If a comment-start appears inside a comment, we may erroneously
324 ;; stop there. This can be rather bad in general, but since
325 ;; comment-search-backward is only used to find the comment-column (in
326 ;; comment-set-column) and to find the comment-start string (via
327 ;; comment-beginning) in indent-new-comment-line, it should be harmless.
2ab98065
SM
328 (if (not (re-search-backward comment-start-skip limit t))
329 (unless noerror (error "No comment"))
330 (beginning-of-line)
331 (let* ((end (match-end 0))
332 (cs (comment-search-forward end t))
333 (pt (point)))
334 (if (not cs)
335 (progn (beginning-of-line)
336 (comment-search-backward limit noerror))
337 (while (progn (goto-char cs)
338 (comment-forward)
339 (and (< (point) end)
340 (setq cs (comment-search-forward end t))))
341 (setq pt (point)))
342 (goto-char pt)
343 cs))))
344
345(defun comment-beginning ()
771c9b97
SM
346 "Find the beginning of the enclosing comment.
347Returns nil if not inside a comment, else moves point and returns
2ab98065
SM
348the same as `comment-search-forward'."
349 (let ((pt (point))
350 (cs (comment-search-backward nil t)))
ad679e45 351 (when cs
392f1ef5
SM
352 (if (save-excursion
353 (goto-char cs)
354 (if (comment-forward 1) (> (point) pt) (eobp)))
ad679e45
SM
355 cs
356 (goto-char pt)
357 nil))))
2ab98065
SM
358
359(defun comment-forward (&optional n)
360 "Skip forward over N comments.
361Just like `forward-comment' but only for positive N
362and can use regexps instead of syntax."
363 (setq n (or n 1))
364 (if (< n 0) (error "No comment-backward")
365 (if comment-use-syntax (forward-comment n)
366 (while (> n 0)
367 (skip-syntax-forward " ")
59a1ce8d
SM
368 (setq n
369 (if (and (looking-at comment-start-skip)
370 (re-search-forward comment-end-skip nil 'move))
371 (1- n) -1)))
2ab98065
SM
372 (= n 0))))
373
374(defun comment-enter-backward ()
375 "Move from the end of a comment to the end of its content.
771c9b97 376Point is assumed to be just at the end of a comment."
2ab98065
SM
377 (if (bolp)
378 ;; comment-end = ""
379 (progn (backward-char) (skip-syntax-backward " "))
380 (let ((end (point)))
381 (beginning-of-line)
382 (save-restriction
383 (narrow-to-region (point) end)
ad679e45
SM
384 (if (re-search-forward (concat comment-end-skip "\\'") nil t)
385 (goto-char (match-beginning 0))
386 ;; comment-end-skip not found probably because it was not set right.
387 ;; Since \\s> should catch the single-char case, we'll blindly
388 ;; assume we're at the end of a two-char comment-end.
389 (goto-char (point-max))
390 (backward-char 2)
391 (skip-chars-backward (string (char-after)))
392 (skip-syntax-backward " "))))))
2ab98065
SM
393
394;;;;
395;;;; Commands
396;;;;
397
fae99944 398;;;###autoload
87cf8421
SM
399(defun comment-indent-default ()
400 "Default for `comment-indent-function'."
d3fcda22
SM
401 (if (and (looking-at "\\s<\\s<\\(\\s<\\)?")
402 (or (match-end 1) (/= (current-column) (current-indentation))))
403 0
87cf8421
SM
404 (when (or (/= (current-column) (current-indentation))
405 (and (> comment-add 0) (looking-at "\\s<\\S<")))
406 comment-column)))
407
be83ecb2 408;;;###autoload
3e569d22 409(defun comment-indent (&optional continue)
2ab98065
SM
410 "Indent this line's comment to comment column, or insert an empty comment.
411If CONTINUE is non-nil, use the `comment-continuation' markers if any."
83b96b22 412 (interactive "*")
ad679e45 413 (comment-normalize-vars)
83b96b22
SM
414 (let* ((empty (save-excursion (beginning-of-line)
415 (looking-at "[ \t]*$")))
f5215400 416 (starter (or (and continue comment-continue)
2ab98065 417 (and empty block-comment-start) comment-start))
f5215400 418 (ender (or (and continue comment-continue "")
2ab98065 419 (and empty block-comment-end) comment-end)))
2e1fbba4
SM
420 (unless starter (error "No comment syntax defined"))
421 (beginning-of-line)
422 (let* ((eolpos (line-end-position))
423 (begpos (comment-search-forward eolpos t))
424 cpos indent)
425 ;; An existing comment?
426 (if begpos (setq cpos (point-marker))
427 ;; If none, insert one.
428 (save-excursion
429 ;; Some comment-indent-function insist on not moving comments that
430 ;; are in column 0, so we insert a space to avoid this special case
431 (insert " ")
432 (setq begpos (point))
bb304a7a 433 (insert starter)
2e1fbba4
SM
434 (setq cpos (point-marker))
435 (insert ender)))
436 (goto-char begpos)
437 ;; Compute desired indent.
053b8d35 438 (setq indent (save-excursion (funcall comment-indent-function)))
2e1fbba4
SM
439 (if (not indent)
440 ;; comment-indent-function refuses delegates to indent.
441 (indent-according-to-mode)
442 ;; Avoid moving comments past the fill-column.
443 (setq indent
444 (min indent
445 (+ (current-column)
446 (- fill-column
447 (save-excursion (end-of-line) (current-column))))))
448 (if (= (current-column) indent)
449 (goto-char begpos)
450 ;; If that's different from current, change it.
451 (skip-chars-backward " \t")
452 (delete-region (point) begpos)
453 (indent-to (if (bolp) indent
454 (max indent (1+ (current-column)))))))
455 (goto-char cpos)
456 (set-marker cpos nil))))
83b96b22 457
be83ecb2 458;;;###autoload
3e569d22 459(defun comment-set-column (arg)
83b96b22 460 "Set the comment column based on point.
2ab98065 461With no ARG, set the comment column to the current column.
83b96b22
SM
462With just minus as arg, kill any comment on this line.
463With any other arg, set comment column to indentation of the previous comment
464 and then align or create a comment on this line at that column."
465 (interactive "P")
e8fe7d39 466 (cond
ad679e45 467 ((eq arg '-) (comment-kill nil))
e8fe7d39
SM
468 (arg
469 (save-excursion
470 (beginning-of-line)
2ab98065 471 (comment-search-backward)
e8fe7d39 472 (beginning-of-line)
ad679e45 473 (goto-char (comment-search-forward (line-end-position)))
83b96b22 474 (setq comment-column (current-column))
e8fe7d39 475 (message "Comment column set to %d" comment-column))
ad679e45 476 (comment-indent))
e8fe7d39 477 (t (setq comment-column (current-column))
83b96b22
SM
478 (message "Comment column set to %d" comment-column))))
479
be83ecb2 480;;;###autoload
3e569d22 481(defun comment-kill (arg)
7a0a180a
SM
482 "Kill the comment on this line, if any.
483With prefix ARG, kill comments on that many lines starting with this one."
484 (interactive "P")
ad679e45
SM
485 (dotimes (_ (prefix-numeric-value arg))
486 (save-excursion
487 (beginning-of-line)
488 (let ((cs (comment-search-forward (line-end-position) t)))
489 (when cs
490 (goto-char cs)
491 (skip-syntax-backward " ")
492 (setq cs (point))
493 (comment-forward)
494 (kill-region cs (if (bolp) (1- (point)) (point)))
495 (indent-according-to-mode))))
496 (if arg (forward-line 1))))
7a0a180a 497
2ab98065
SM
498(defun comment-padright (str &optional n)
499 "Construct a string composed of STR plus `comment-padding'.
f5215400 500It also adds N copies of the last non-whitespace chars of STR.
2ab98065 501If STR already contains padding, the corresponding amount is
f5215400
SM
502ignored from `comment-padding'.
503N defaults to 0.
771c9b97 504If N is `re', a regexp is returned instead, that would match
f5215400 505the string for any N."
2ab98065
SM
506 (setq n (or n 0))
507 (when (and (stringp str) (not (string= "" str)))
f5215400 508 ;; Separate the actual string from any leading/trailing padding
3e569d22 509 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
f5215400
SM
510 (let ((s (match-string 1 str)) ;actual string
511 (lpad (substring str 0 (match-beginning 1))) ;left padding
512 (rpad (concat (substring str (match-end 1)) ;original right padding
513 (substring comment-padding ;additional right padding
3e569d22 514 (min (- (match-end 0) (match-end 1))
9b0d1d6e
SM
515 (length comment-padding)))))
516 ;; We can only duplicate C if the comment-end has multiple chars
517 ;; or if comments can be nested, else the comment-end `}' would
518 ;; be turned into `}}}' where only the first ends the comment
519 ;; and the rest becomes bogus junk.
520 (multi (not (and comment-quote-nested
521 ;; comment-end is a single char
522 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
f5215400 523 (if (not (symbolp n))
9b0d1d6e 524 (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
f5215400
SM
525 ;; construct a regexp that would match anything from just S
526 ;; to any possible output of this function for any N.
527 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
528 lpad "") ;padding is not required
9b0d1d6e
SM
529 (regexp-quote s)
530 (when multi "+") ;the last char of S might be repeated
f5215400
SM
531 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
532 rpad "")))))) ;padding is not required
2ab98065
SM
533
534(defun comment-padleft (str &optional n)
535 "Construct a string composed of `comment-padding' plus STR.
f5215400 536It also adds N copies of the first non-whitespace chars of STR.
2ab98065 537If STR already contains padding, the corresponding amount is
f5215400
SM
538ignored from `comment-padding'.
539N defaults to 0.
771c9b97 540If N is `re', a regexp is returned instead, that would match
2ab98065
SM
541 the string for any N."
542 (setq n (or n 0))
543 (when (and (stringp str) (not (string= "" str)))
f5215400 544 ;; Only separate the left pad because we assume there is no right pad.
2ab98065
SM
545 (string-match "\\`\\s-*" str)
546 (let ((s (substring str (match-end 0)))
547 (pad (concat (substring comment-padding
548 (min (- (match-end 0) (match-beginning 0))
549 (length comment-padding)))
550 (match-string 0 str)))
f5215400
SM
551 (c (aref str (match-end 0))) ;the first non-space char of STR
552 ;; We can only duplicate C if the comment-end has multiple chars
553 ;; or if comments can be nested, else the comment-end `}' would
554 ;; be turned into `}}}' where only the first ends the comment
555 ;; and the rest becomes bogus junk.
556 (multi (not (and comment-quote-nested
557 ;; comment-end is a single char
558 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
559 (if (not (symbolp n))
560 (concat pad (when multi (make-string n c)) s)
561 ;; Construct a regexp that would match anything from just S
562 ;; to any possible output of this function for any N.
563 ;; We match any number of leading spaces because this regexp will
564 ;; be used for uncommenting where we might want to remove
565 ;; uncomment markers with arbitrary leading space (because
566 ;; they were aligned).
567 (concat "\\s-*"
568 (if multi (concat (regexp-quote (string c)) "*"))
569 (regexp-quote s))))))
83b96b22 570
be83ecb2 571;;;###autoload
7a0a180a
SM
572(defun uncomment-region (beg end &optional arg)
573 "Uncomment each line in the BEG..END region.
f5215400
SM
574The numeric prefix ARG can specify a number of chars to remove from the
575comment markers."
83b96b22
SM
576 (interactive "*r\nP")
577 (comment-normalize-vars)
578 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
579 (save-excursion
7a0a180a 580 (goto-char beg)
f5215400 581 (setq end (copy-marker end))
7a0a180a 582 (let ((numarg (prefix-numeric-value arg))
2ab98065 583 spt)
7a0a180a 584 (while (and (< (point) end)
2ab98065
SM
585 (setq spt (comment-search-forward end t)))
586 (let* ((ipt (point))
f5215400 587 ;; Find the end of the comment.
e8fe7d39 588 (ept (progn
2ab98065
SM
589 (goto-char spt)
590 (unless (comment-forward)
e8fe7d39 591 (error "Can't find the comment end"))
f5215400
SM
592 (point)))
593 (box nil)
594 (ccs comment-continue)
2ab98065 595 (srei (comment-padright ccs 're))
3e569d22 596 (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))))
e8fe7d39
SM
597 (save-restriction
598 (narrow-to-region spt ept)
f5215400 599 ;; Remove the comment-start.
2ab98065
SM
600 (goto-char ipt)
601 (skip-syntax-backward " ")
9b0d1d6e
SM
602 ;; Check for special `=' used sometimes in comment-box.
603 (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}"))
604 (skip-chars-forward "="))
f5215400 605 ;; A box-comment starts with a looong comment-start marker.
2ab98065 606 (when (> (- (point) (point-min) (length comment-start)) 7)
f5215400 607 (setq box t))
2ab98065
SM
608 (when (looking-at (regexp-quote comment-padding))
609 (goto-char (match-end 0)))
610 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
611 (goto-char (match-end 0)))
3e569d22
SM
612 (if (null arg) (delete-region (point-min) (point))
613 (skip-syntax-backward " ")
614 (delete-char (- numarg)))
2ab98065 615
f5215400 616 ;; Remove the end-comment (and leading padding and such).
2ab98065 617 (goto-char (point-max)) (comment-enter-backward)
9b0d1d6e 618 ;; Check for special `=' used sometimes in comment-box.
6dcd3806
SM
619 (when (= (- (point-max) (point)) 1)
620 (let ((pos (point)))
621 ;; skip `=' but only if there are at least 7.
622 (when (> (skip-chars-backward "=") -7) (goto-char pos))))
9b0d1d6e 623 (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
2ab98065 624 (when (and (bolp) (not (bobp))) (backward-char))
f5215400 625 (if (null arg) (delete-region (point) (point-max))
3e569d22
SM
626 (skip-syntax-forward " ")
627 (delete-char numarg)))
e8fe7d39 628
f5215400
SM
629 ;; Unquote any nested end-comment.
630 (comment-quote-nested comment-start comment-end t)
631
632 ;; Eliminate continuation markers as well.
633 (when sre
634 (let* ((cce (comment-string-reverse (or comment-continue
635 comment-start)))
636 (erei (and box (comment-padleft cce 're)))
637 (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))
7a0a180a 638 (goto-char (point-min))
f5215400
SM
639 (while (progn
640 (if (and ere (re-search-forward
641 ere (line-end-position) t))
642 (replace-match "" t t nil (if (match-end 2) 2 1))
643 (setq ere nil))
644 (forward-line 1)
645 (re-search-forward sre (line-end-position) t))
2ab98065 646 (replace-match "" t t nil (if (match-end 2) 2 1)))))
f5215400
SM
647 ;; Go the the end for the next comment.
648 (goto-char (point-max)))))
649 (set-marker end nil))))
83b96b22 650
aac88001 651(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
ad679e45
SM
652 "Make the leading and trailing extra lines.
653This is used for `extra-line' style (or `box' style if BLOCK is specified)."
9b0d1d6e
SM
654 (let ((eindent 0))
655 (if (not block)
656 ;; Try to match CS and CE's content so they align aesthetically.
657 (progn
658 (setq ce (comment-string-strip ce t t))
659 (when (string-match "\\(.+\\).*\n\\(.*?\\)\\1" (concat ce "\n" cs))
660 (setq eindent
661 (max (- (match-end 2) (match-beginning 2) (match-beginning 0))
662 0))))
663 ;; box comment
664 (let* ((width (- max-indent min-indent))
665 (s (concat cs "a=m" cce))
666 (e (concat ccs "a=m" ce))
667 (c (if (string-match ".*\\S-\\S-" cs)
668 (aref cs (1- (match-end 0))) ?=))
3fc5b4e2 669 (_ (string-match "\\s-*a=m\\s-*" s))
9b0d1d6e
SM
670 (fill
671 (make-string (+ width (- (match-end 0)
672 (match-beginning 0) (length cs) 3)) c)))
aac88001 673 (setq cs (replace-match fill t t s))
3fc5b4e2 674 (string-match "\\s-*a=m\\s-*" e)
9b0d1d6e
SM
675 (setq ce (replace-match fill t t e))))
676 (cons (concat cs "\n" (make-string min-indent ? ) ccs)
677 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce))))
aac88001
SM
678
679(def-edebug-spec comment-with-narrowing t)
680(put 'comment-with-narrowing 'lisp-indent-function 2)
681(defmacro comment-with-narrowing (beg end &rest body)
682 "Execute BODY with BEG..END narrowing.
683Space is added (and then removed) at the beginning for the text's
684indentation to be kept as it was before narrowing."
59a1ce8d
SM
685 (let ((bindent (make-symbol "bindent")))
686 `(let ((,bindent (save-excursion (goto-char beg) (current-column))))
687 (save-restriction
688 (narrow-to-region beg end)
689 (goto-char (point-min))
690 (insert (make-string ,bindent ? ))
691 (prog1
692 (progn ,@body)
693 ;; remove the bindent
694 (save-excursion
695 (goto-char (point-min))
696 (when (looking-at " *")
697 (let ((n (min (- (match-end 0) (match-beginning 0)) ,bindent)))
aac88001 698 (delete-char n)
59a1ce8d
SM
699 (setq ,bindent (- ,bindent n))))
700 (end-of-line)
701 (let ((e (point)))
702 (beginning-of-line)
703 (while (and (> ,bindent 0) (re-search-forward " *" e t))
704 (let ((n (min ,bindent (- (match-end 0) (match-beginning 0) 1))))
705 (goto-char (match-beginning 0))
706 (delete-char n)
707 (setq ,bindent (- ,bindent n)))))))))))
aac88001 708
771c9b97
SM
709(defun comment-region-internal (beg end cs ce
710 &optional ccs cce block lines indent)
f5215400 711 "Comment region BEG..END.
4125ec7e
SM
712CS and CE are the comment start resp end string.
713CCS and CCE are the comment continuation strings for the start resp end
f5215400
SM
714of lines (default to CS and CE).
715BLOCK indicates that end of lines should be marked with either CCE, CE or CS
716\(if CE is empty) and that those markers should be aligned.
717LINES indicates that an extra lines will be used at the beginning and end
718of the region for CE and CS.
719INDENT indicates to put CS and CCS at the current indentation of the region
720rather than at left margin."
59a1ce8d 721 ;;(assert (< beg end))
83b96b22 722 (let ((no-empty t))
f5215400 723 ;; Sanitize CE and CCE.
83b96b22
SM
724 (if (and (stringp ce) (string= "" ce)) (setq ce nil))
725 (if (and (stringp cce) (string= "" cce)) (setq cce nil))
f5215400
SM
726 ;; If CE is empty, multiline cannot be used.
727 (unless ce (setq ccs nil cce nil))
728 ;; Should we mark empty lines as well ?
83b96b22 729 (if (or ccs block lines) (setq no-empty nil))
f5215400 730 ;; Make sure we have end-markers for BLOCK mode.
2ab98065 731 (when block (unless ce (setq ce (comment-string-reverse cs))))
f5215400
SM
732 ;; If BLOCK is not requested, we don't need CCE.
733 (unless block (setq cce nil))
734 ;; Continuation defaults to the same as CS and CE.
735 (unless ccs (setq ccs cs cce ce))
7a0a180a 736
83b96b22 737 (save-excursion
aac88001 738 (goto-char end)
f5215400
SM
739 ;; If the end is not at the end of a line and the comment-end
740 ;; is implicit (i.e. a newline), explicitly insert a newline.
aac88001
SM
741 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
742 (comment-with-narrowing beg end
f5215400 743 (let ((min-indent (point-max))
83b96b22
SM
744 (max-indent 0))
745 (goto-char (point-min))
f5215400
SM
746 ;; Quote any nested comment marker
747 (comment-quote-nested comment-start comment-end nil)
748
749 ;; Loop over all lines to find the needed indentations.
4125ec7e 750 (goto-char (point-min))
f5215400
SM
751 (while
752 (progn
753 (unless (looking-at "[ \t]*$")
754 (setq min-indent (min min-indent (current-indentation))))
755 (end-of-line)
756 (setq max-indent (max max-indent (current-column)))
757 (not (or (eobp) (progn (forward-line) nil)))))
758
759 ;; Inserting ccs can change max-indent by (1- tab-width).
59a1ce8d
SM
760 (setq max-indent
761 (+ max-indent (max (length cs) (length ccs)) tab-width -1))
771c9b97 762 (unless indent (setq min-indent 0))
83b96b22 763
aac88001 764 ;; make the leading and trailing lines if requested
83b96b22 765 (when lines
771c9b97
SM
766 (let ((csce
767 (comment-make-extra-lines
768 cs ce ccs cce min-indent max-indent block)))
769 (setq cs (car csce))
770 (setq ce (cdr csce))))
83b96b22
SM
771
772 (goto-char (point-min))
773 ;; Loop over all lines from BEG to END.
f5215400
SM
774 (while
775 (progn
776 (unless (and no-empty (looking-at "[ \t]*$"))
777 (move-to-column min-indent t)
778 (insert cs) (setq cs ccs) ;switch to CCS after the first line
779 (end-of-line)
780 (if (eobp) (setq cce ce))
781 (when cce
782 (when block (move-to-column max-indent t))
783 (insert cce)))
784 (end-of-line)
785 (not (or (eobp) (progn (forward-line) nil))))))))))
83b96b22 786
be83ecb2 787;;;###autoload
83b96b22
SM
788(defun comment-region (beg end &optional arg)
789 "Comment or uncomment each line in the region.
39cb51e7 790With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END.
83b96b22
SM
791Numeric prefix arg ARG means use ARG comment characters.
792If ARG is negative, delete that many comment characters instead.
be83ecb2
SM
793By default, comments start at the left margin, are terminated on each line,
794even for syntax in which newline does not end the comment and blank lines
795do not get comments. This can be changed with `comment-style'.
83b96b22
SM
796
797The strings used as comment starts are built from
798`comment-start' without trailing spaces and `comment-padding'."
799 (interactive "*r\nP")
800 (comment-normalize-vars)
801 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
2ab98065 802 (let* ((numarg (prefix-numeric-value arg))
771c9b97 803 (add comment-add)
2ab98065
SM
804 (style (cdr (assoc comment-style comment-styles)))
805 (lines (nth 2 style))
806 (block (nth 1 style))
807 (multi (nth 0 style)))
83b96b22
SM
808 (save-excursion
809 ;; we use `chars' instead of `syntax' because `\n' might be
810 ;; of end-comment syntax rather than of whitespace syntax.
811 ;; sanitize BEG and END
812 (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
813 (setq beg (max beg (point)))
814 (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
815 (setq end (min end (point)))
816 (if (>= beg end) (error "Nothing to comment"))
817
83b96b22
SM
818 ;; sanitize LINES
819 (setq lines
820 (and
9b0d1d6e 821 lines ;; multi
83b96b22
SM
822 (progn (goto-char beg) (beginning-of-line)
823 (skip-syntax-forward " ")
824 (>= (point) beg))
825 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
826 (<= (point) end))
771c9b97 827 (or (not (string= "" comment-end)) block)
2ab98065 828 (progn (goto-char beg) (search-forward "\n" end t)))))
83b96b22 829
2ab98065
SM
830 ;; don't add end-markers just because the user asked for `block'
831 (unless (or lines (string= "" comment-end)) (setq block nil))
832
83b96b22
SM
833 (cond
834 ((consp arg) (uncomment-region beg end))
835 ((< numarg 0) (uncomment-region beg end (- numarg)))
836 (t
59a1ce8d
SM
837 (setq numarg (if (and (null arg) (= (length comment-start) 1))
838 add (1- numarg)))
83b96b22
SM
839 (comment-region-internal
840 beg end
3e569d22
SM
841 (let ((s (comment-padright comment-start numarg)))
842 (if (string-match comment-start-skip s) s
843 (comment-padright comment-start)))
844 (let ((s (comment-padleft comment-end numarg)))
845 (and s (if (string-match comment-end-skip s) s
846 (comment-padright comment-end))))
f5215400
SM
847 (if multi (comment-padright comment-continue numarg))
848 (if multi (comment-padleft (comment-string-reverse comment-continue) numarg))
83b96b22 849 block
771c9b97
SM
850 lines
851 (nth 3 style))))))
852
853(defun comment-box (beg end &optional arg)
854 "Comment out the BEG..END region, putting it inside a box.
855The numeric prefix ARG specifies how many characters to add to begin- and
856end- comment markers additionally to what `comment-add' already specifies."
857 (interactive "*r\np")
9b0d1d6e
SM
858 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
859 'box-multi 'box)))
771c9b97 860 (comment-region beg end (+ comment-add arg))))
83b96b22 861
be83ecb2 862;;;###autoload
2ab98065 863(defun comment-dwim (arg)
ad679e45
SM
864 "Call the comment command you want (Do What I Mean).
865If the region is active and `transient-mark-mode' is on, call
39cb51e7 866 `comment-region' (unless it only consists of comments, in which
ad679e45 867 case it calls `uncomment-region').
2ab98065 868Else, if the current line is empty, insert a comment and indent it.
ad679e45
SM
869Else if a prefix ARG is specified, call `comment-kill'.
870Else, call `comment-indent'."
2ab98065
SM
871 (interactive "*P")
872 (comment-normalize-vars)
771c9b97 873 (if (and mark-active transient-mark-mode)
2ab98065
SM
874 (let ((beg (min (point) (mark)))
875 (end (max (point) (mark))))
876 (if (save-excursion ;; check for already commented region
877 (goto-char beg)
878 (comment-forward (point-max))
879 (<= end (point)))
880 (uncomment-region beg end arg)
881 (comment-region beg end arg)))
882 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
ad679e45
SM
883 ;; FIXME: If there's no comment to kill on this line and ARG is
884 ;; specified, calling comment-kill is not very clever.
885 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent))
2ab98065 886 (let ((add (if arg (prefix-numeric-value arg)
771c9b97 887 (if (= (length comment-start) 1) comment-add 0))))
2e1fbba4
SM
888 ;; Some modes insist on keeping column 0 comment in column 0
889 ;; so we need to move away from it before inserting the comment.
890 (indent-according-to-mode)
2ab98065
SM
891 (insert (comment-padright comment-start add))
892 (save-excursion
893 (unless (string= "" comment-end)
894 (insert (comment-padleft comment-end add)))
895 (indent-according-to-mode))))))
896
392f1ef5
SM
897(defcustom comment-auto-fill-only-comments nil
898 "Non-nil means to only auto-fill inside comments.
899This has no effect in modes that do not define a comment syntax."
900 :type 'boolean
901 :group 'comment)
902
be83ecb2 903;;;###autoload
ad679e45 904(defun comment-indent-new-line (&optional soft)
2ab98065
SM
905 "Break line at point and indent, continuing comment if within one.
906This indents the body of the continued comment
907under the previous comment line.
908
909This command is intended for styles where you write a comment per line,
910starting a new comment (and terminating it if necessary) on each line.
911If you want to continue one comment across several lines, use \\[newline-and-indent].
912
913If a fill column is specified, it overrides the use of the comment column
914or comment indentation.
915
916The inserted newline is marked hard if variable `use-hard-newlines' is true,
917unless optional argument SOFT is non-nil."
918 (interactive)
919 (comment-normalize-vars t)
59a1ce8d
SM
920 (let (compos comin)
921 ;; If we are not inside a comment and we only auto-fill comments,
922 ;; don't do anything (unless no comment syntax is defined).
392f1ef5
SM
923 (unless (and comment-start
924 comment-auto-fill-only-comments
925 (not (save-excursion
59a1ce8d 926 (prog1 (setq compos (comment-beginning))
392f1ef5 927 (setq comin (point))))))
59a1ce8d
SM
928
929 ;; Now we know we should auto-fill.
adf9c994 930 (delete-horizontal-space)
392f1ef5
SM
931 (if soft (insert-and-inherit ?\n) (newline 1))
932 (if fill-prefix
933 (progn
934 (indent-to-left-margin)
935 (insert-and-inherit fill-prefix))
59a1ce8d
SM
936
937 ;; If necessary check whether we're inside a comment.
938 (unless (or comment-multi-line compos (null comment-start))
392f1ef5
SM
939 (save-excursion
940 (backward-char)
59a1ce8d
SM
941 (setq compos (comment-beginning))
942 (setq comin (point))))
943
944 ;; If we're not inside a comment, just try to indent.
945 (if (not compos) (indent-according-to-mode)
946 (let* ((comment-column
947 ;; The continuation indentation should be somewhere between
948 ;; the current line's indentation (plus 2 for good measure)
949 ;; and the current comment's indentation, with a preference
950 ;; for comment-column.
951 (save-excursion
952 (goto-char compos)
953 (min (current-column) (max comment-column
954 (+ 2 (current-indentation))))))
955 (comstart (buffer-substring compos comin))
956 (normalp
957 (string-match (regexp-quote (comment-string-strip
958 comment-start t t))
959 comstart))
960 (comment-end
961 (if normalp comment-end
962 ;; The comment starter is not the normal comment-start
963 ;; so we can't just use comment-end.
964 (save-excursion
965 (goto-char compos)
966 (if (not (comment-forward)) comment-end
967 (comment-string-strip
968 (buffer-substring
969 (save-excursion (comment-enter-backward) (point))
970 (point))
971 nil t)))))
972 (comment-start comstart)
973 ;; Force comment-continue to be recreated from comment-start.
974 (comment-continue nil))
975 (insert-and-inherit ?\n)
976 (forward-char -1)
977 (comment-indent (cadr (assoc comment-style comment-styles)))
978 (save-excursion
979 (let ((pt (point)))
980 (end-of-line)
981 (let ((comend (buffer-substring pt (point))))
982 ;; The 1+ is to make sure we delete the \n inserted above.
983 (delete-region pt (1+ (point)))
984 (beginning-of-line)
985 (backward-char)
986 (insert comend)
987 (forward-char))))))))))
2ab98065 988
83b96b22
SM
989(provide 'newcomment)
990
83b96b22 991;;; newcomment.el ends here