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