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