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