aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier1999-11-30 16:20:55 +0000
committerStefan Monnier1999-11-30 16:20:55 +0000
commit2ab98065f3ae0d35d877a85dde6f9dfc02b29a5b (patch)
treeca65bb94b36181112c54f1a913422d97f9cab789
parent0f29c6a89e946957685d48504b99477f376acf61 (diff)
downloademacs-2ab98065f3ae0d35d877a85dde6f9dfc02b29a5b.tar.gz
emacs-2ab98065f3ae0d35d877a85dde6f9dfc02b29a5b.zip
(comment-style(s)): Replaces comment-extra-lines (and comment-multi-line).
(comment-use-syntax): Whether to use the syntax-table or just the regexps. (comment-end-skip): To find the end of the text. ...
-rw-r--r--lisp/newcomment.el607
1 files changed, 444 insertions, 163 deletions
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 901c8e3ef2e..097c4666ba0 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -5,7 +5,7 @@
5;; Author: Stefan Monnier <monnier@cs.yale.edu> 5;; Author: Stefan Monnier <monnier@cs.yale.edu>
6;; Keywords: comment uncomment 6;; Keywords: comment uncomment
7;; Version: $Name: $ 7;; Version: $Name: $
8;; Revision: $Id: newcomment.el,v 1.3 1999/11/29 00:49:18 monnier Exp $ 8;; Revision: $Id: newcomment.el,v 1.4 1999/11/29 01:31:47 monnier Exp $
9 9
10;; This program is free software; you can redistribute it and/or modify 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 11;; it under the terms of the GNU General Public License as published by
@@ -27,8 +27,11 @@
27 27
28;;; Bugs: 28;;; Bugs:
29 29
30;; - comment-multi-line already exists with a different meaning 30;; - single-char nestable comment-start can only do the "\\s<+" stuff
31;; and is not orthogonal to comment-extra-lines 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
32 35
33;;; Todo: 36;;; Todo:
34 37
@@ -38,12 +41,23 @@
38;; - uncomment-region with a numeric argument 41;; - uncomment-region with a numeric argument
39;; - uncomment-region with a consp (for blocks) or somehow make the 42;; - uncomment-region with a consp (for blocks) or somehow make the
40;; deletion of continuation markers less dangerous 43;; deletion of continuation markers less dangerous
41;; - fix set-comment-column to not use comment-start-skip 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.
42 53
43;;; Code: 54;;; Code:
44 55
45(eval-when-compile (require 'cl)) 56(eval-when-compile (require 'cl))
46 57
58(defcustom comment-use-syntax 'maybe
59 "Non-nil if syntax-tables can be used instead of regexps.")
60
47(defcustom comment-column 32 61(defcustom comment-column 32
48 "*Column to indent right-margin comments to. 62 "*Column to indent right-margin comments to.
49Setting this variable automatically makes it local to the current buffer. 63Setting this variable automatically makes it local to the current buffer.
@@ -66,6 +80,11 @@ at the place matched by the close of the first pair."
66 :type '(choice (const :tag "None" nil) 80 :type '(choice (const :tag "None" nil)
67 regexp) 81 regexp)
68 :group 'fill-comments) 82 :group 'fill-comments)
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)
69 88
70(defcustom comment-end "" 89(defcustom comment-end ""
71 "*String to insert to end a new comment. 90 "*String to insert to end a new comment.
@@ -101,30 +120,224 @@ If nil, use `comment-end' instead."
101 string) 120 string)
102 :group 'fill-comments) 121 :group 'fill-comments)
103 122
104(defun comment-find (&optional limit noerror) 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.
146Can also be a string instead.
147
148Extra spacing between the comment characters and the comment text
149makes 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.
225The regexp has one group in it which matches RE right after the
226potential 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)
105 "Find a comment start between the point and LIMIT. 238 "Find a comment start between the point and LIMIT.
106Moves the point to inside the comment and returns the position of the 239Moves the point to inside the comment and returns the position of the
107comment-starter. If no comment is found, moves the point to LIMIT 240comment-starter. If no comment is found, moves the point to LIMIT
108and raises an error or returns nil of NOERROR is non-nil." 241and raises an error or returns nil of NOERROR is non-nil."
109 (let ((s (parse-partial-sexp (point) (or limit (point-max)) nil nil nil t))) 242 (if (not comment-use-syntax)
110 (if (and (nth 8 s) (not (nth 3 s))) 243 (when (re-search-forward comment-start-skip limit noerror)
111 (nth 8 s) 244 (or (match-end 1) (match-beginning 0)))
112 (unless noerror (error "No comment"))))) 245 (let ((s (parse-partial-sexp (point) (or limit (point-max)) nil nil nil t)))
113 246 (if (and (nth 8 s) (not (nth 3 s)))
114(defun indent-for-comment () 247 (let ((pt (point))
115 "Indent this line's comment to comment column, or insert an empty comment." 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.
261Moves the point to inside the comment and returns the position of the
262comment-starter. If no comment is found, moves the point to LIMIT
263and 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.
283Returns nil if not inside a comment, else moves the point and returns
284the 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.
294Just like `forward-comment' but only for positive N
295and 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.
309The 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.
326If CONTINUE is non-nil, use the `comment-continuation' markers if any."
116 (interactive "*") 327 (interactive "*")
117 (let* ((empty (save-excursion (beginning-of-line) 328 (let* ((empty (save-excursion (beginning-of-line)
118 (looking-at "[ \t]*$"))) 329 (looking-at "[ \t]*$")))
119 (starter (or (and empty block-comment-start) comment-start)) 330 (starter (or (and continue (car comment-continue))
120 (ender (or (and empty block-comment-end) comment-end))) 331 (and empty block-comment-start) comment-start))
332 (ender (or (and continue (car comment-continue) "")
333 (and empty block-comment-end) comment-end)))
121 (cond 334 (cond
122 ((null starter) 335 ((null starter)
123 (error "No comment syntax defined")) 336 (error "No comment syntax defined"))
124 (t (let* ((eolpos (save-excursion (end-of-line) (point))) 337 (t (let* ((eolpos (save-excursion (end-of-line) (point)))
125 cpos indent begpos) 338 cpos indent begpos)
126 (beginning-of-line) 339 (beginning-of-line)
127 (when (setq begpos (comment-find eolpos t)) 340 (when (setq begpos (comment-search-forward eolpos t))
128 (skip-chars-forward 341 (skip-chars-forward
129 (concat (buffer-substring (1- (point)) (point)) " \t")) 342 (concat (buffer-substring (1- (point)) (point)) " \t"))
130 (setq cpos (point-marker)) 343 (setq cpos (point-marker))
@@ -151,7 +364,7 @@ and raises an error or returns nil of NOERROR is non-nil."
151 364
152(defun set-comment-column (arg) 365(defun set-comment-column (arg)
153 "Set the comment column based on point. 366 "Set the comment column based on point.
154With no arg, set the comment column to the current column. 367With no ARG, set the comment column to the current column.
155With just minus as arg, kill any comment on this line. 368With just minus as arg, kill any comment on this line.
156With any other arg, set comment column to indentation of the previous comment 369With any other arg, set comment column to indentation of the previous comment
157 and then align or create a comment on this line at that column." 370 and then align or create a comment on this line at that column."
@@ -161,36 +374,15 @@ With any other arg, set comment column to indentation of the previous comment
161 (arg 374 (arg
162 (save-excursion 375 (save-excursion
163 (beginning-of-line) 376 (beginning-of-line)
164 (re-search-backward comment-start-skip) 377 (comment-search-backward)
165 (beginning-of-line) 378 (beginning-of-line)
166 (goto-char (comment-find)) 379 (goto-char (comment-search-forward))
167 (setq comment-column (current-column)) 380 (setq comment-column (current-column))
168 (message "Comment column set to %d" comment-column)) 381 (message "Comment column set to %d" comment-column))
169 (indent-for-comment)) 382 (indent-for-comment))
170 (t (setq comment-column (current-column)) 383 (t (setq comment-column (current-column))
171 (message "Comment column set to %d" comment-column)))) 384 (message "Comment column set to %d" comment-column))))
172 385
173(defcustom comment-nested nil
174 "Whether the comments can be nested.")
175(defcustom comment-continue nil
176 "Pair of strings to insert for multiline comments.")
177(defcustom comment-add '(0 . 2)
178 "How many more chars should be inserted by default.")
179(defcustom comment-extra-lines nil
180 "When comments should have an extra line before and after.
181If nil, never add them.
182If t, always add them,
183If 'multiline, only add them for truly multiline comments.")
184;; (defcustom comment-multiline t
185;; "non-nil if `comment-region' should use multi-line comments.")
186
187(defvar comment-padding 1
188 "Number of spaces `comment-region' puts between comment chars and text.
189Can also be a string instead.
190
191Extra spacing between the comment characters and the comment text
192makes the comment easier to read. Default is 1. Nil means 0.")
193
194(defun kill-comment (arg) 386(defun kill-comment (arg)
195 "Kill the comment on this line, if any. 387 "Kill the comment on this line, if any.
196With prefix ARG, kill comments on that many lines starting with this one." 388With prefix ARG, kill comments on that many lines starting with this one."
@@ -201,51 +393,62 @@ With prefix ARG, kill comments on that many lines starting with this one."
201 (end-of-line) 393 (end-of-line)
202 (setq endc (point)) 394 (setq endc (point))
203 (beginning-of-line) 395 (beginning-of-line)
204 (let ((cs (comment-find endc t))) 396 (let ((cs (comment-search-forward endc t)))
205 (when cs 397 (when cs
206 (goto-char cs) 398 (goto-char cs)
207 (skip-syntax-backward " ") 399 (skip-syntax-backward " ")
208 (setq cs (point)) 400 (setq cs (point))
209 (forward-comment 1) 401 (comment-forward)
210 (skip-syntax-backward " ")
211 (kill-region cs (if (bolp) (1- (point)) (point))) 402 (kill-region cs (if (bolp) (1- (point)) (point)))
212 (indent-according-to-mode)))) 403 (indent-according-to-mode))))
213 (if arg (forward-line 1))))) 404 (if arg (forward-line 1)))))
214 405
215(defun comment-normalize-vars () 406(defun comment-padright (str &optional n)
216 (or comment-start (error "No comment syntax is defined")) 407 "Construct a string composed of STR plus `comment-padding'.
217 (when (integerp comment-padding) 408It contains N copies of the last non-whitespace chars of STR.
218 (setq comment-padding (make-string comment-padding ? ))) 409If STR already contains padding, the corresponding amount is
219 ;; 410 ignored from `comment-padding'.
220 (when (string-match "\\`\\s-*\\(.*\\S-\\)\\s-*\\'" comment-start) 411N defaults to 1.
221 (setq comment-start (match-string 1 comment-start))) 412It N is 're, a regexp is returned instead, that would match
222 (when (string-match "\\`\\s-*\\(.*\\S-\\)\\s-*\\'" comment-end) 413 the string for any N."
223 (setq comment-end (match-string 1 comment-end))) 414 (setq n (or n 0))
224 ;; 415 (when (and (stringp str) (not (string= "" str)))
225 (unless (or (car comment-continue) (string= comment-end "")) 416 (string-match "\\s-*\\'" str)
226 (set (make-local-variable 'comment-continue) 417 (let ((s (substring str 0 (match-beginning 0)))
227 (cons (concat " " (substring comment-start 1)) 418 (pad (concat (match-string 0 str)
228 nil))) 419 (substring comment-padding
229 (when (and (car comment-continue) (null (cdr comment-continue))) 420 (min (- (match-end 0) (match-beginning 0))
230 (setf (cdr comment-continue) (string-reverse (car comment-continue))))) 421 (length comment-padding))))))
231 422 (if (symbolp n)
232(defmacro until (&rest body) 423 (concat (regexp-quote s) "+"
233 (let ((retsym (make-symbol "ret"))) 424 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
234 `(let (,retsym) 425 pad ""))
235 (while (not (setq ,retsym (progn ,@body)))) 426 (concat s (make-string n (aref str (1- (match-beginning 0)))) pad)))))
236 ,retsym))) 427
237(def-edebug-spec until t) 428(defun comment-padleft (str &optional n)
238 429 "Construct a string composed of `comment-padding' plus STR.
239(defun string-reverse (s) (concat (reverse (string-to-list s)))) 430It contains N copies of the last non-whitespace chars of STR.
240 431If STR already contains padding, the corresponding amount is
241(defun comment-end-quote-re (str &optional re) 432 ignored from `comment-padding'.
242 "Make a regexp that matches the (potentially quoted) STR comment-end. 433N defaults to 1.
243The regexp has one group in it which matches RE right after the 434It N is 're, a regexp is returned instead, that would match
244potential quoting." 435 the string for any N."
245 (when (and (not comment-nested) (> (length str) 1)) 436 (setq n (or n 0))
246 (concat (regexp-quote (substring str 0 1)) 437 (when (and (stringp str) (not (string= "" str)))
247 "\\\\*\\(" re "\\)" 438 (string-match "\\`\\s-*" str)
248 (regexp-quote (substring str 1))))) 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)))))
249 452
250(defun uncomment-region (beg end &optional arg) 453(defun uncomment-region (beg end &optional arg)
251 "Uncomment each line in the BEG..END region. 454 "Uncomment each line in the BEG..END region.
@@ -257,52 +460,40 @@ ARG is currently ignored."
257 (goto-char beg) 460 (goto-char beg)
258 (unless (markerp end) (setq end (copy-marker end))) 461 (unless (markerp end) (setq end (copy-marker end)))
259 (let ((numarg (prefix-numeric-value arg)) 462 (let ((numarg (prefix-numeric-value arg))
260 state spt) 463 spt)
261 (while (and (< (point) end) 464 (while (and (< (point) end)
262 (setq state (parse-partial-sexp 465 (setq spt (comment-search-forward end t)))
263 (point) end 466 (let* ((ipt (point))
264 nil nil nil t))
265 (setq spt (nth 8 state))
266 (not (nth 3 state)))
267 (let* ((stxt (buffer-substring spt (point)))
268 ;; find the end of the comment 467 ;; find the end of the comment
269 (ept (progn 468 (ept (progn
270 (when (nth 8 (parse-partial-sexp 469 (goto-char spt)
271 (point) (point-max) 470 (unless (comment-forward)
272 nil nil state 'syntax-table))
273 (error "Can't find the comment end")) 471 (error "Can't find the comment end"))
274 (point-marker))) 472 (point-marker)))
275 ;; find the start of the end-comment 473 (block nil)
276 (_ (while (save-excursion 474 (end-quote-re (comment-end-quote-re comment-end "\\\\"))
277 (save-restriction 475 (ccs (car comment-continue))
278 (narrow-to-region (point) ept) 476 (srei (comment-padright ccs 're))
279 (nth 8 477 (sre (and srei (concat "^\\s-*\\(" srei "\\)"))))
280 (parse-partial-sexp (point) ept
281 nil nil state))))
282 (backward-char)))
283 (etxt (buffer-substring (point) ept))
284 (end-quote-re (comment-end-quote-re etxt "\\\\")))
285 (save-restriction 478 (save-restriction
286 (narrow-to-region spt ept) 479 (narrow-to-region spt ept)
287 ;; remove the end-comment (and leading padding and such)
288 (unless (string= "\n" etxt)
289 (beginning-of-line)
290 (re-search-forward (concat "\\(^\\s-*\\|\\("
291 (regexp-quote comment-padding)
292 "\\)?\\)"
293 (regexp-quote (substring etxt 0 1))
294 "+"
295 (regexp-quote (substring etxt 1))
296 "\\'"))
297 (delete-region (match-beginning 0) (match-end 0)))
298
299 ;; remove the comment-start 480 ;; remove the comment-start
300 (goto-char (point-min)) 481 (goto-char ipt)
301 (looking-at (concat (regexp-quote stxt) 482 (skip-syntax-backward " ")
302 "+\\(\\s-*$\\|" 483 (when (> (- (point) (point-min) (length comment-start)) 7)
303 (regexp-quote comment-padding) 484 (setq block t))
304 "\\)")) 485 (when (looking-at (regexp-quote comment-padding))
305 (delete-region (match-beginning 0) (match-end 0)) 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))
306 497
307 ;; unquote any nested end-comment 498 ;; unquote any nested end-comment
308 (when end-quote-re 499 (when end-quote-re
@@ -311,24 +502,18 @@ ARG is currently ignored."
311 (delete-region (match-beginning 1) (match-end 1)))) 502 (delete-region (match-beginning 1) (match-end 1))))
312 503
313 ;; eliminate continuation markers as well 504 ;; eliminate continuation markers as well
314 (let* ((ccs (car comment-continue)) 505 (let* ((cce (or (cdr comment-continue)
315 (cce (cdr comment-continue)) 506 (comment-string-reverse comment-start)))
316 (sre (when (and (stringp ccs) (not (string= "" ccs))) 507 (erei (and block (comment-padleft cce 're)))
317 (concat 508 (ere (and erei (concat "\\(" erei "\\)\\s-*$")))
318 "^\\s-*\\(" (regexp-quote ccs) 509 (re (if (and sre ere) (concat sre "\\|" ere) (or sre ere))))
319 "+\\(" (regexp-quote comment-padding)
320 "\\)?\\)")))
321 (ere (when (and (stringp cce) (not (string= "" cce)))
322 (concat
323 "\\(\\(" (regexp-quote comment-padding)
324 "\\)?" (regexp-quote cce) "\\)\\s-*$")))
325 (re (if (and sre ere) (concat sre "\\|" ere)
326 (or sre ere))))
327 (when re 510 (when re
328 (goto-char (point-min)) 511 (goto-char (point-min))
512 ;; there can't be a real SRE on the first line.
513 (when (and sre (looking-at sre)) (goto-char (match-end 0)))
329 (while (re-search-forward re nil t) 514 (while (re-search-forward re nil t)
330 (replace-match "" t t nil (if (match-end 1) 1 3))))) 515 (replace-match "" t t nil (if (match-end 2) 2 1)))))
331 ;; go the the end for the next comment 516 ;; go the the end for the next comment
332 (goto-char (point-max)))))))) 517 (goto-char (point-max))))))))
333 518
334(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block) 519(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
@@ -398,7 +583,7 @@ indentation to be kept as it was before narrowing."
398 ;; should we mark empty lines as well ? 583 ;; should we mark empty lines as well ?
399 (if (or ccs block lines) (setq no-empty nil)) 584 (if (or ccs block lines) (setq no-empty nil))
400 ;; make sure we have end-markers for BLOCK mode 585 ;; make sure we have end-markers for BLOCK mode
401 (when block (unless ce (setq ce (string-reverse cs)))) 586 (when block (unless ce (setq ce (comment-string-reverse cs))))
402 ;; continuation defaults to the same 587 ;; continuation defaults to the same
403 (if ccs (unless block (setq cce nil)) 588 (if ccs (unless block (setq cce nil))
404 (setq ccs cs cce ce)) 589 (setq ccs cs cce ce))
@@ -447,16 +632,6 @@ indentation to be kept as it was before narrowing."
447 (end-of-line) 632 (end-of-line)
448 (or (eobp) (progn (forward-line) nil)))))))) 633 (or (eobp) (progn (forward-line) nil))))))))
449 634
450(defun comment-addright (str n)
451 (when (and (stringp str) (not (string= "" str)))
452 (concat str (make-string n (aref str (1- (length str)))) comment-padding)))
453(defun comment-addleft (str n)
454 (when (and (stringp str) (not (string= "" str)))
455 (concat comment-padding
456 (when (or comment-nested (> (length comment-end) 1))
457 (make-string n (aref str 0)))
458 str)))
459
460(defun comment-region (beg end &optional arg) 635(defun comment-region (beg end &optional arg)
461 "Comment or uncomment each line in the region. 636 "Comment or uncomment each line in the region.
462With just \\[universal-prefix] prefix arg, uncomment each line in region BEG..END. 637With just \\[universal-prefix] prefix arg, uncomment each line in region BEG..END.
@@ -470,10 +645,12 @@ The strings used as comment starts are built from
470 (interactive "*r\nP") 645 (interactive "*r\nP")
471 (comment-normalize-vars) 646 (comment-normalize-vars)
472 (if (> beg end) (let (mid) (setq mid beg beg end end mid))) 647 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
473 (let ((numarg (prefix-numeric-value arg)) 648 (let* ((numarg (prefix-numeric-value arg))
474 (add (car comment-add)) 649 (add (car comment-add))
475 (lines comment-extra-lines) 650 (style (cdr (assoc comment-style comment-styles)))
476 (block nil)) 651 (lines (nth 2 style))
652 (block (nth 1 style))
653 (multi (nth 0 style)))
477 (save-excursion 654 (save-excursion
478 ;; we use `chars' instead of `syntax' because `\n' might be 655 ;; we use `chars' instead of `syntax' because `\n' might be
479 ;; of end-comment syntax rather than of whitespace syntax. 656 ;; of end-comment syntax rather than of whitespace syntax.
@@ -484,29 +661,26 @@ The strings used as comment starts are built from
484 (setq end (min end (point))) 661 (setq end (min end (point)))
485 (if (>= beg end) (error "Nothing to comment")) 662 (if (>= beg end) (error "Nothing to comment"))
486 663
487 ;; check for already commented region
488 (goto-char beg)
489 (forward-comment (point-max))
490 (if (< end (point)) (setq arg '(4) numarg 4))
491
492 ;; sanitize LINES 664 ;; sanitize LINES
493 (setq lines 665 (setq lines
494 (and 666 (and
495 comment-multi-line 667 lines multi
496 (progn (goto-char beg) (beginning-of-line) 668 (progn (goto-char beg) (beginning-of-line)
497 (skip-syntax-forward " ") 669 (skip-syntax-forward " ")
498 (>= (point) beg)) 670 (>= (point) beg))
499 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ") 671 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
500 (<= (point) end)) 672 (<= (point) end))
501 (if (eq comment-extra-lines 'multiline) 673 (not (string= "" comment-end))
502 (and (not (string= "" comment-end)) 674 (progn (goto-char beg) (search-forward "\n" end t)))))
503 (progn (goto-char beg)
504 (search-forward "\n" end t)))
505 lines))))
506 675
676 ;; C-u C-u makes a full block
507 (when (and (consp arg) (>= numarg 16)) 677 (when (and (consp arg) (>= numarg 16))
508 (setq lines (>= numarg 64)) 678 (setq lines t block t add (or (cdr comment-add) 2))
509 (setq arg nil numarg 1 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
510 (cond 684 (cond
511 ((consp arg) (uncomment-region beg end)) 685 ((consp arg) (uncomment-region beg end))
512 ((< numarg 0) (uncomment-region beg end (- numarg))) 686 ((< numarg 0) (uncomment-region beg end (- numarg)))
@@ -515,19 +689,126 @@ The strings used as comment starts are built from
515 (setq numarg add) (decf numarg)) 689 (setq numarg add) (decf numarg))
516 (comment-region-internal 690 (comment-region-internal
517 beg end 691 beg end
518 (comment-addright comment-start numarg) 692 (comment-padright comment-start numarg)
519 (comment-addleft comment-end numarg) 693 (comment-padleft comment-end numarg)
520 (if comment-multi-line 694 (if multi (comment-padright (car comment-continue) numarg))
521 (comment-addright (car comment-continue) numarg)) 695 (if multi (comment-padleft (cdr comment-continue) numarg))
522 (if comment-multi-line
523 (comment-addleft (cdr comment-continue) numarg))
524 block 696 block
525 lines))))) 697 lines)))))
526 698
699(defun comment-dwim (arg)
700 "Call the comment command you want.
701If the region is active, calls `comment-region' (unless it only consists
702in comments, in which case it calls `uncomment-region').
703Else, if the current line is empty, insert a comment and indent it.
704Else 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
728on new line, with no new terminator or starter.
729This 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.
735This indents the body of the continued comment
736under the previous comment line.
737
738This command is intended for styles where you write a comment per line,
739starting a new comment (and terminating it if necessary) on each line.
740If you want to continue one comment across several lines, use \\[newline-and-indent].
741
742If a fill column is specified, it overrides the use of the comment column
743or comment indentation.
744
745The inserted newline is marked hard if variable `use-hard-newlines' is true,
746unless 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
527(provide 'newcomment) 804(provide 'newcomment)
528 805
529;;; Change Log: 806;;; Change Log:
530;; $Log: newcomment.el,v $ 807;; $Log: newcomment.el,v $
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;;
531;; Revision 1.3 1999/11/29 00:49:18 monnier 812;; Revision 1.3 1999/11/29 00:49:18 monnier
532;; (kill-comment): Fixed by rewriting it with syntax-tables rather than regexps 813;; (kill-comment): Fixed by rewriting it with syntax-tables rather than regexps
533;; (comment-normalize-vars): Set default (cdr comment-continue) 814;; (comment-normalize-vars): Set default (cdr comment-continue)