|
1333
|
1 ;;; newcomment.el --- (un)comment regions of buffers
|
|
|
2
|
|
|
3 ;; Copyright (C) 1999, 2000 Free Software Foundation Inc.
|
|
|
4
|
|
|
5 ;; Author: code extracted from Emacs-20's simple.el
|
|
|
6 ;; Maintainer: Stefan Monnier <monnier@cs.yale.edu>
|
|
|
7 ;; Keywords: comment uncomment
|
|
|
8 ;; Revision: $Id: newcomment.el,v 1.1 2003/03/02 09:38:40 ben Exp $
|
|
|
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 2, or (at your option)
|
|
|
15 ;; 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; see the file COPYING. If not, write to the
|
|
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; A replacement for simple.el's comment-related functions.
|
|
|
30
|
|
|
31 ;;; Bugs:
|
|
|
32
|
|
|
33 ;; - single-char nestable comment-start can only do the "\\s<+" stuff
|
|
|
34 ;; if the corresponding closing marker happens to be right.
|
|
|
35 ;; - comment-box in TeXinfo generate bogus comments @ccccc@
|
|
|
36 ;; - uncomment-region with a numeric argument can render multichar
|
|
|
37 ;; comment markers invalid.
|
|
|
38 ;; - comment-indent or comment-region when called inside a comment
|
|
|
39 ;; will happily break the surrounding comment.
|
|
|
40 ;; - comment-quote-nested will not (un)quote properly all nested comment
|
|
|
41 ;; markers if there are more than just comment-start and comment-end.
|
|
|
42 ;; For example, in Pascal where {...*) and (*...} are possible.
|
|
|
43
|
|
|
44 ;;; Todo:
|
|
|
45
|
|
|
46 ;; - quantized steps in comment-alignment
|
|
|
47 ;; - try to align tail comments
|
|
|
48 ;; - check what c-comment-line-break-function has to say
|
|
|
49 ;; - spill auto-fill of comments onto the end of the next line
|
|
|
50 ;; - uncomment-region with a consp (for blocks) or somehow make the
|
|
|
51 ;; deletion of continuation markers less dangerous
|
|
|
52 ;; - drop block-comment-<foo> unless it's really used
|
|
|
53 ;; - uncomment-region on a subpart of a comment
|
|
|
54 ;; - support gnu-style "multi-line with space in continue"
|
|
|
55 ;; - somehow allow comment-dwim to use the region even if transient-mark-mode
|
|
|
56 ;; is not turned on.
|
|
|
57
|
|
|
58 ;; - when auto-filling a comment, try to move the comment to the left
|
|
|
59 ;; rather than break it (if possible).
|
|
|
60 ;; - sometimes default the comment-column to the same
|
|
|
61 ;; one used on the preceding line(s).
|
|
|
62
|
|
|
63 ;;; Code:
|
|
|
64
|
|
|
65 ;;;###autoload
|
|
|
66 (defalias 'indent-for-comment 'comment-indent)
|
|
|
67 ;;;###autoload
|
|
|
68 (defalias 'set-comment-column 'comment-set-column)
|
|
|
69 ;;;###autoload
|
|
|
70 (defalias 'kill-comment 'comment-kill)
|
|
|
71 ;;;###autoload
|
|
|
72 (defalias 'indent-new-comment-line 'comment-indent-new-line)
|
|
|
73
|
|
|
74 ;;;###autoload
|
|
|
75 (defgroup comment nil
|
|
|
76 "Indenting and filling of comments."
|
|
|
77 :prefix "comment-"
|
|
|
78 :version "21.1"
|
|
|
79 :group 'fill)
|
|
|
80
|
|
|
81 (defvar comment-use-syntax 'undecided
|
|
|
82 "Non-nil if syntax-tables can be used instead of regexps.
|
|
|
83 Can also be `undecided' which means that a somewhat expensive test will
|
|
|
84 be used to try to determine whether syntax-tables should be trusted
|
|
|
85 to understand comments or not in the given buffer.
|
|
|
86 Major modes should set this variable.")
|
|
|
87
|
|
|
88 ;;;###autoload
|
|
|
89 (defcustom comment-column 32
|
|
|
90 "*Column to indent right-margin comments to.
|
|
|
91 Setting this variable automatically makes it local to the current buffer.
|
|
|
92 Each mode establishes a different default value for this variable; you
|
|
|
93 can set the value for a particular mode using that mode's hook."
|
|
|
94 :type 'integer
|
|
|
95 :group 'comment)
|
|
|
96 (make-variable-buffer-local 'comment-column)
|
|
|
97
|
|
|
98 ;;;###autoload
|
|
|
99 (defvar comment-start nil
|
|
|
100 "*String to insert to start a new comment, or nil if no comment syntax.")
|
|
|
101
|
|
|
102 ;;;###autoload
|
|
|
103 (defvar comment-start-skip nil
|
|
|
104 "*Regexp to match the start of a comment plus everything up to its body.
|
|
|
105 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
|
|
|
106 at the place matched by the close of the first pair.")
|
|
|
107
|
|
|
108 ;;;###autoload
|
|
|
109 (defvar comment-end-skip nil
|
|
|
110 "Regexp to match the end of a comment plus everything up to its body.")
|
|
|
111
|
|
|
112 ;;;###autoload
|
|
|
113 (defvar comment-end ""
|
|
|
114 "*String to insert to end a new comment.
|
|
|
115 Should be an empty string if comments are terminated by end-of-line.")
|
|
|
116
|
|
|
117 ;;;###autoload
|
|
|
118 (defvar comment-indent-function 'comment-indent-default
|
|
|
119 "Function to compute desired indentation for a comment.
|
|
|
120 This function is called with no args with point at the beginning of
|
|
|
121 the comment's starting delimiter and should return either the desired
|
|
|
122 column indentation or nil.
|
|
|
123 If nil is returned, indentation is delegated to `indent-according-to-mode'.")
|
|
|
124
|
|
|
125 (defvar block-comment-start nil)
|
|
|
126 (defvar block-comment-end nil)
|
|
|
127
|
|
|
128 (defvar comment-quote-nested t
|
|
|
129 "Non-nil if nested comments should be quoted.
|
|
|
130 This should be locally set by each major mode if needed.")
|
|
|
131
|
|
|
132 (defvar comment-continue nil
|
|
|
133 "Continuation string to insert for multiline comments.
|
|
|
134 This string will be added at the beginning of each line except the very
|
|
|
135 first one when commenting a region with a commenting style that allows
|
|
|
136 comments to span several lines.
|
|
|
137 It should generally have the same length as `comment-start' in order to
|
|
|
138 preserve indentation.
|
|
|
139 If it is nil a value will be automatically derived from `comment-start'
|
|
|
140 by replacing its first character with a space.")
|
|
|
141
|
|
|
142 (defvar comment-add 0
|
|
|
143 "How many more comment chars should be inserted by `comment-region'.
|
|
|
144 This determines the default value of the numeric argument of `comment-region'.
|
|
|
145 This should generally stay 0, except for a few modes like Lisp where
|
|
|
146 it can be convenient to set it to 1 so that regions are commented with
|
|
|
147 two semi-colons.")
|
|
|
148
|
|
|
149 (defconst comment-styles
|
|
|
150 '((plain . (nil nil nil nil))
|
|
|
151 (indent . (nil nil nil t))
|
|
|
152 (aligned . (nil t nil t))
|
|
|
153 (multi-line . (t nil nil t))
|
|
|
154 (extra-line . (t nil t t))
|
|
|
155 (box . (nil t t t))
|
|
|
156 (box-multi . (t t t t)))
|
|
|
157 "Possible comment styles of the form (STYLE . (MULTI ALIGN EXTRA INDENT)).
|
|
|
158 STYLE should be a mnemonic symbol.
|
|
|
159 MULTI specifies that comments are allowed to span multiple lines.
|
|
|
160 ALIGN specifies that the `comment-end' markers should be aligned.
|
|
|
161 EXTRA specifies that an extra line should be used before and after the
|
|
|
162 region to comment (to put the `comment-end' and `comment-start').
|
|
|
163 INDENT specifies that the `comment-start' markers should not be put at the
|
|
|
164 left margin but at the current indentation of the region to comment.")
|
|
|
165
|
|
|
166 ;;;###autoload
|
|
|
167 (defcustom comment-style 'plain
|
|
|
168 "*Style to be used for `comment-region'.
|
|
|
169 See `comment-styles' for a list of available styles."
|
|
|
170 :group 'comment
|
|
|
171 :type (if (boundp 'comment-styles)
|
|
|
172 `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles))
|
|
|
173 'symbol))
|
|
|
174
|
|
|
175 ;;;###autoload
|
|
|
176 (defcustom comment-padding " "
|
|
|
177 "Padding string that `comment-region' puts between comment chars and text.
|
|
|
178 Can also be an integer which will be automatically turned into a string
|
|
|
179 of the corresponding number of spaces.
|
|
|
180
|
|
|
181 Extra spacing between the comment characters and the comment text
|
|
|
182 makes the comment easier to read. Default is \" \". nil means 0."
|
|
|
183 :group 'comment
|
|
|
184 :type '(choice string integer (const nil)))
|
|
|
185
|
|
|
186 ;;;###autoload
|
|
|
187 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill
|
|
|
188 "*Non-nil means \\[indent-new-comment-line] should continue same comment
|
|
|
189 on new line, with no new terminator or starter.
|
|
|
190 This is obsolete because you might as well use \\[newline-and-indent]."
|
|
|
191 :type 'boolean
|
|
|
192 :group 'comment)
|
|
|
193
|
|
|
194 ;;;;
|
|
|
195 ;;;; Helpers
|
|
|
196 ;;;;
|
|
|
197
|
|
|
198 (defun comment-string-strip (str beforep afterp)
|
|
|
199 "Strip STR of any leading (if BEFOREP) and/or trailing (if AFTERP) space."
|
|
|
200 (string-match (concat "\\`" (if beforep "\\s-*")
|
|
|
201 "\\(.*?\\)" (if afterp "\\s-*\n?")
|
|
|
202 "\\'") str)
|
|
|
203 (match-string 1 str))
|
|
|
204
|
|
|
205 (defun comment-string-reverse (s)
|
|
|
206 "Return the mirror image of string S, without any trailing space."
|
|
|
207 (comment-string-strip (concat (nreverse (string-to-list s))) nil t))
|
|
|
208
|
|
|
209 (defun comment-normalize-vars (&optional noerror)
|
|
|
210 (if (not comment-start) (or noerror (error "No comment syntax is defined"))
|
|
|
211 ;; comment-use-syntax
|
|
|
212 (when (eq comment-use-syntax 'undecided)
|
|
|
213 (set (make-local-variable 'comment-use-syntax)
|
|
|
214 (let ((st (syntax-table))
|
|
|
215 (cs comment-start)
|
|
|
216 (ce (if (string= "" comment-end) "\n" comment-end)))
|
|
|
217 ;; Try to skip over a comment using forward-comment
|
|
|
218 ;; to see if the syntax tables properly recognize it.
|
|
|
219 (with-temp-buffer
|
|
|
220 (set-syntax-table st)
|
|
|
221 (insert cs " hello " ce)
|
|
|
222 (goto-char (point-min))
|
|
|
223 (and (forward-comment 1) (eobp))))))
|
|
|
224 ;; comment-padding
|
|
|
225 (unless comment-padding (setq comment-padding 0))
|
|
|
226 (when (integerp comment-padding)
|
|
|
227 (setq comment-padding (make-string comment-padding ? )))
|
|
|
228 ;; comment markers
|
|
|
229 ;;(setq comment-start (comment-string-strip comment-start t nil))
|
|
|
230 ;;(setq comment-end (comment-string-strip comment-end nil t))
|
|
|
231 ;; comment-continue
|
|
|
232 (unless (or comment-continue (string= comment-end ""))
|
|
|
233 (set (make-local-variable 'comment-continue)
|
|
|
234 (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
|
|
|
235 (substring comment-start 1))))
|
|
|
236 ;; comment-skip regexps
|
|
|
237 (unless comment-start-skip
|
|
|
238 (set (make-local-variable 'comment-start-skip)
|
|
|
239 (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
|
|
|
240 (regexp-quote (comment-string-strip comment-start t t))
|
|
|
241 ;; Let's not allow any \s- but only [ \t] since \n
|
|
|
242 ;; might be both a comment-end marker and \s-.
|
|
|
243 "+\\)[ \t]*")))
|
|
|
244 (unless comment-end-skip
|
|
|
245 (let ((ce (if (string= "" comment-end) "\n"
|
|
|
246 (comment-string-strip comment-end t t))))
|
|
|
247 (set (make-local-variable 'comment-end-skip)
|
|
|
248 ;; We use [ \t] rather than \s- because we don't want to
|
|
|
249 ;; remove ^L in C mode when uncommenting.
|
|
|
250 (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
|
|
|
251 "\\|" (regexp-quote (substring ce 0 1))
|
|
|
252 (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
|
|
|
253 (regexp-quote (substring ce 1))
|
|
|
254 "\\)"))))))
|
|
|
255
|
|
|
256 (defun comment-quote-re (str unp)
|
|
|
257 (concat (regexp-quote (substring str 0 1))
|
|
|
258 "\\\\" (if unp "+" "*")
|
|
|
259 (regexp-quote (substring str 1))))
|
|
|
260
|
|
|
261 (defun comment-quote-nested (cs ce unp)
|
|
|
262 "Quote or unquote nested comments.
|
|
|
263 If UNP is non-nil, unquote nested comment markers."
|
|
|
264 (setq cs (comment-string-strip cs t t))
|
|
|
265 (setq ce (comment-string-strip ce t t))
|
|
|
266 (when (and comment-quote-nested (> (length ce) 0))
|
|
|
267 (let ((re (concat (comment-quote-re ce unp)
|
|
|
268 "\\|" (comment-quote-re cs unp))))
|
|
|
269 (goto-char (point-min))
|
|
|
270 (while (re-search-forward re nil t)
|
|
|
271 (goto-char (match-beginning 0))
|
|
|
272 (forward-char 1)
|
|
|
273 (if unp (delete-char 1) (insert "\\"))
|
|
|
274 (when (= (length ce) 1)
|
|
|
275 ;; If the comment-end is a single char, adding a \ after that
|
|
|
276 ;; "first" char won't deactivate it, so we turn such a CE
|
|
|
277 ;; into !CS. I.e. for pascal, we turn } into !{
|
|
|
278 (if (not unp)
|
|
|
279 (when (string= (match-string 0) ce)
|
|
|
280 (replace-match (concat "!" cs) t t))
|
|
|
281 (when (and (< (point-min) (match-beginning 0))
|
|
|
282 (string= (buffer-substring (1- (match-beginning 0))
|
|
|
283 (1- (match-end 0)))
|
|
|
284 (concat "!" cs)))
|
|
|
285 (backward-char 2)
|
|
|
286 (delete-char (- (match-end 0) (match-beginning 0)))
|
|
|
287 (insert ce))))))))
|
|
|
288
|
|
|
289 ;;;;
|
|
|
290 ;;;; Navigation
|
|
|
291 ;;;;
|
|
|
292
|
|
|
293 (defun comment-search-forward (limit &optional noerror)
|
|
|
294 "Find a comment start between point and LIMIT.
|
|
|
295 Moves point to inside the comment and returns the position of the
|
|
|
296 comment-starter. If no comment is found, moves point to LIMIT
|
|
|
297 and raises an error or returns nil of NOERROR is non-nil."
|
|
|
298 (if (not comment-use-syntax)
|
|
|
299 (if (re-search-forward comment-start-skip limit noerror)
|
|
|
300 (or (match-end 1) (match-beginning 0))
|
|
|
301 (goto-char limit)
|
|
|
302 (unless noerror (error "No comment")))
|
|
|
303 (let* ((pt (point))
|
|
|
304 ;; Assume (at first) that pt is outside of any string.
|
|
|
305 (s (parse-partial-sexp pt (or limit (point-max)) nil nil nil t)))
|
|
|
306 (when (and (nth 8 s) (nth 3 s))
|
|
|
307 ;; The search ended inside a string. Try to see if it
|
|
|
308 ;; works better when we assume that pt is inside a string.
|
|
|
309 (setq s (parse-partial-sexp
|
|
|
310 pt (or limit (point-max)) nil nil
|
|
|
311 (list nil nil nil (nth 3 s) nil nil nil nil)
|
|
|
312 t)))
|
|
|
313 (if (not (and (nth 8 s) (not (nth 3 s))))
|
|
|
314 (unless noerror (error "No comment"))
|
|
|
315 ;; We found the comment.
|
|
|
316 (let ((pos (point))
|
|
|
317 (start (nth 8 s))
|
|
|
318 (bol (line-beginning-position))
|
|
|
319 (end nil))
|
|
|
320 (while (and (null end) (>= (point) bol))
|
|
|
321 (if (looking-at comment-start-skip)
|
|
|
322 (setq end (min (or limit (point-max)) (match-end 0)))
|
|
|
323 (backward-char)))
|
|
|
324 (goto-char (or end pos))
|
|
|
325 start)))))
|
|
|
326
|
|
|
327 (defun comment-search-backward (&optional limit noerror)
|
|
|
328 "Find a comment start between LIMIT and point.
|
|
|
329 Moves point to inside the comment and returns the position of the
|
|
|
330 comment-starter. If no comment is found, moves point to LIMIT
|
|
|
331 and raises an error or returns nil of NOERROR is non-nil."
|
|
|
332 ;; FIXME: If a comment-start appears inside a comment, we may erroneously
|
|
|
333 ;; stop there. This can be rather bad in general, but since
|
|
|
334 ;; comment-search-backward is only used to find the comment-column (in
|
|
|
335 ;; comment-set-column) and to find the comment-start string (via
|
|
|
336 ;; comment-beginning) in indent-new-comment-line, it should be harmless.
|
|
|
337 (if (not (re-search-backward comment-start-skip limit t))
|
|
|
338 (unless noerror (error "No comment"))
|
|
|
339 (beginning-of-line)
|
|
|
340 (let* ((end (match-end 0))
|
|
|
341 (cs (comment-search-forward end t))
|
|
|
342 (pt (point)))
|
|
|
343 (if (not cs)
|
|
|
344 (progn (beginning-of-line)
|
|
|
345 (comment-search-backward limit noerror))
|
|
|
346 (while (progn (goto-char cs)
|
|
|
347 (comment-forward)
|
|
|
348 (and (< (point) end)
|
|
|
349 (setq cs (comment-search-forward end t))))
|
|
|
350 (setq pt (point)))
|
|
|
351 (goto-char pt)
|
|
|
352 cs))))
|
|
|
353
|
|
|
354 (defun comment-beginning ()
|
|
|
355 "Find the beginning of the enclosing comment.
|
|
|
356 Returns nil if not inside a comment, else moves point and returns
|
|
|
357 the same as `comment-search-forward'."
|
|
|
358 ;; HACK ATTACK!
|
|
|
359 ;; We should really test `in-string-p' but that can be expensive.
|
|
|
360 (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
|
|
|
361 (let ((pt (point))
|
|
|
362 (cs (comment-search-backward nil t)))
|
|
|
363 (when cs
|
|
|
364 (if (save-excursion
|
|
|
365 (goto-char cs)
|
|
|
366 (and
|
|
|
367 ;; For modes where comment-start and comment-end are the same,
|
|
|
368 ;; the search above may have found a `ce' rather than a `cs'.
|
|
|
369 (or (not (looking-at comment-end-skip))
|
|
|
370 ;; Maybe font-lock knows that it's a `cs'?
|
|
|
371 (eq (get-text-property (match-end 0) 'face)
|
|
|
372 'font-lock-comment-face)
|
|
|
373 (unless (eq (get-text-property (point) 'face)
|
|
|
374 'font-lock-comment-face)
|
|
|
375 ;; Let's assume it's a `cs' if we're on the same line.
|
|
|
376 (>= (line-end-position) pt)))
|
|
|
377 ;; Make sure that PT is not past the end of the comment.
|
|
|
378 (if (comment-forward 1) (> (point) pt) (eobp))))
|
|
|
379 cs
|
|
|
380 (goto-char pt)
|
|
|
381 nil)))))
|
|
|
382
|
|
|
383 (defun comment-forward (&optional n)
|
|
|
384 "Skip forward over N comments.
|
|
|
385 Just like `forward-comment' but only for positive N
|
|
|
386 and can use regexps instead of syntax."
|
|
|
387 (setq n (or n 1))
|
|
|
388 (if (< n 0) (error "No comment-backward")
|
|
|
389 (if comment-use-syntax (forward-comment n)
|
|
|
390 (while (> n 0)
|
|
|
391 (setq n
|
|
|
392 (if (or (forward-comment 1)
|
|
|
393 (and (looking-at comment-start-skip)
|
|
|
394 (goto-char (match-end 0))
|
|
|
395 (re-search-forward comment-end-skip nil 'move)))
|
|
|
396 (1- n) -1)))
|
|
|
397 (= n 0))))
|
|
|
398
|
|
|
399 (defun comment-enter-backward ()
|
|
|
400 "Move from the end of a comment to the end of its content.
|
|
|
401 Point is assumed to be just at the end of a comment."
|
|
|
402 (if (bolp)
|
|
|
403 ;; comment-end = ""
|
|
|
404 (progn (backward-char) (skip-syntax-backward " "))
|
|
|
405 (let ((end (point)))
|
|
|
406 (beginning-of-line)
|
|
|
407 (save-restriction
|
|
|
408 (narrow-to-region (point) end)
|
|
|
409 (if (re-search-forward (concat comment-end-skip "\\'") nil t)
|
|
|
410 (goto-char (match-beginning 0))
|
|
|
411 ;; comment-end-skip not found probably because it was not set right.
|
|
|
412 ;; Since \\s> should catch the single-char case, we'll blindly
|
|
|
413 ;; assume we're at the end of a two-char comment-end.
|
|
|
414 (goto-char (point-max))
|
|
|
415 (backward-char 2)
|
|
|
416 (skip-chars-backward (string (char-after)))
|
|
|
417 (skip-syntax-backward " "))))))
|
|
|
418
|
|
|
419 ;;;;
|
|
|
420 ;;;; Commands
|
|
|
421 ;;;;
|
|
|
422
|
|
|
423 ;;;###autoload
|
|
|
424
|
|
|
425 ;; #### XEmacs had this: in place of just (current-column)
|
|
|
426 ; (defconst comment-indent-function
|
|
|
427 ; ;; XEmacs - add at least one space after the end of the text on the
|
|
|
428 ; ;; current line...
|
|
|
429 ; (lambda ()
|
|
|
430 ; (save-excursion
|
|
|
431 ; (beginning-of-line)
|
|
|
432 ; (let ((eol (save-excursion (end-of-line) (point))))
|
|
|
433 ; (and comment-start-skip
|
|
|
434 ; (re-search-forward comment-start-skip eol t)
|
|
|
435 ; (setq eol (match-beginning 0)))
|
|
|
436 ; (goto-char eol)
|
|
|
437 ; (skip-chars-backward " \t")
|
|
|
438 ; (max comment-column (1+ (current-column))))))
|
|
|
439 ; "Function to compute desired indentation for a comment.
|
|
|
440 ; This function is called with no args with point at the beginning of
|
|
|
441 ; the comment's starting delimiter.")
|
|
|
442
|
|
|
443 (defun comment-indent-default ()
|
|
|
444 "Default for `comment-indent-function'."
|
|
|
445 (if (and (looking-at "\\s<\\s<\\(\\s<\\)?")
|
|
|
446 (or (match-end 1) (/= (current-column) (current-indentation))))
|
|
|
447 0
|
|
|
448 (when (or (/= (current-column) (current-indentation))
|
|
|
449 (and (> comment-add 0) (looking-at "\\s<\\S<")))
|
|
|
450 comment-column)))
|
|
|
451
|
|
|
452 ;;;###autoload
|
|
|
453 (defun comment-indent (&optional continue)
|
|
|
454 "Indent this line's comment to comment column, or insert an empty comment.
|
|
|
455 If CONTINUE is non-nil, use the `comment-continue' markers if any.
|
|
|
456 Comments starting in column 0 are not moved."
|
|
|
457 (interactive "*")
|
|
|
458 (comment-normalize-vars)
|
|
|
459 (let* ((empty (save-excursion (beginning-of-line)
|
|
|
460 (looking-at "[ \t]*$")))
|
|
|
461 (starter (or (and continue comment-continue)
|
|
|
462 (and empty block-comment-start) comment-start))
|
|
|
463 (ender (or (and continue comment-continue "")
|
|
|
464 (and empty block-comment-end) comment-end)))
|
|
|
465 (unless starter (error "No comment syntax defined"))
|
|
|
466 (beginning-of-line)
|
|
|
467 (let* ((eolpos (line-end-position))
|
|
|
468 (begpos (comment-search-forward eolpos t))
|
|
|
469 cpos indent)
|
|
|
470 ;; An existing comment?
|
|
|
471 (if begpos (setq cpos (point-marker))
|
|
|
472 ;; If none, insert one.
|
|
|
473 (save-excursion
|
|
|
474 ;; Some comment-indent-function insist on not moving comments that
|
|
|
475 ;; are in column 0, so we first go to the likely target column.
|
|
|
476 (indent-to comment-column)
|
|
|
477 (setq begpos (point))
|
|
|
478 (insert starter)
|
|
|
479 (setq cpos (point-marker))
|
|
|
480 (insert ender)))
|
|
|
481 (goto-char begpos)
|
|
|
482 ;; Compute desired indent.
|
|
|
483 (setq indent (save-excursion (funcall comment-indent-function)))
|
|
|
484 (if (not indent)
|
|
|
485 ;; comment-indent-function refuses delegates to indent.
|
|
|
486 (indent-according-to-mode)
|
|
|
487 ;; Avoid moving comments past the fill-column.
|
|
|
488 (unless (save-excursion (skip-chars-backward " \t") (bolp))
|
|
|
489 (setq indent
|
|
|
490 (min indent
|
|
|
491 (+ (current-column)
|
|
|
492 (- fill-column
|
|
|
493 (save-excursion (end-of-line) (current-column)))))))
|
|
|
494 ;; XEmacs change: Preserve indentation of comments starting in
|
|
|
495 ;; column 0, as documented.
|
|
|
496 (if (or (= (current-column) 0) (= (current-column) indent))
|
|
|
497 (goto-char begpos)
|
|
|
498 ;; If that's different from current, change it.
|
|
|
499 (skip-chars-backward " \t")
|
|
|
500 (delete-region (point) begpos)
|
|
|
501 (indent-to (if (bolp) indent
|
|
|
502 (max indent (1+ (current-column)))))))
|
|
|
503 (goto-char cpos)
|
|
|
504 (set-marker cpos nil))))
|
|
|
505
|
|
|
506 ;;;###autoload
|
|
|
507 (defun comment-set-column (arg)
|
|
|
508 "Set the comment column based on point.
|
|
|
509 With no ARG, set the comment column to the current column.
|
|
|
510 With just minus as arg, kill any comment on this line.
|
|
|
511 With any other arg, set comment column to indentation of the previous comment
|
|
|
512 and then align or create a comment on this line at that column."
|
|
|
513 (interactive "P")
|
|
|
514 (cond
|
|
|
515 ((eq arg '-) (comment-kill nil))
|
|
|
516 (arg
|
|
|
517 (save-excursion
|
|
|
518 (beginning-of-line)
|
|
|
519 (comment-search-backward)
|
|
|
520 (beginning-of-line)
|
|
|
521 (goto-char (comment-search-forward (line-end-position)))
|
|
|
522 (setq comment-column (current-column))
|
|
|
523 (lmessage 'command "Comment column set to %d" comment-column))
|
|
|
524 (comment-indent))
|
|
|
525 (t (setq comment-column (current-column))
|
|
|
526 (lmessage 'command "Comment column set to %d" comment-column))))
|
|
|
527
|
|
|
528 ;;;###autoload
|
|
|
529 (defun comment-kill (arg)
|
|
|
530 "Kill the comment on this line, if any.
|
|
|
531 With prefix ARG, kill comments on that many lines starting with this one."
|
|
|
532 ;; XEmacs change: add *
|
|
|
533 (interactive "*P")
|
|
|
534 (dotimes (_ (prefix-numeric-value arg))
|
|
|
535 (save-excursion
|
|
|
536 (beginning-of-line)
|
|
|
537 (let ((cs (comment-search-forward (line-end-position) t)))
|
|
|
538 (when cs
|
|
|
539 (goto-char cs)
|
|
|
540 (skip-syntax-backward " ")
|
|
|
541 (setq cs (point))
|
|
|
542 (comment-forward)
|
|
|
543 (kill-region cs (if (bolp) (1- (point)) (point)))
|
|
|
544 (indent-according-to-mode))))
|
|
|
545 (if arg (forward-line 1))))
|
|
|
546
|
|
|
547 (defun comment-padright (str &optional n)
|
|
|
548 "Construct a string composed of STR plus `comment-padding'.
|
|
|
549 It also adds N copies of the last non-whitespace chars of STR.
|
|
|
550 If STR already contains padding, the corresponding amount is
|
|
|
551 ignored from `comment-padding'.
|
|
|
552 N defaults to 0.
|
|
|
553 If N is `re', a regexp is returned instead, that would match
|
|
|
554 the string for any N."
|
|
|
555 (setq n (or n 0))
|
|
|
556 (when (and (stringp str) (not (string= "" str)))
|
|
|
557 ;; Separate the actual string from any leading/trailing padding
|
|
|
558 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
|
|
|
559 (let ((s (match-string 1 str)) ;actual string
|
|
|
560 (lpad (substring str 0 (match-beginning 1))) ;left padding
|
|
|
561 (rpad (concat (substring str (match-end 1)) ;original right padding
|
|
|
562 (substring comment-padding ;additional right padding
|
|
|
563 (min (- (match-end 0) (match-end 1))
|
|
|
564 (length comment-padding)))))
|
|
|
565 ;; We can only duplicate C if the comment-end has multiple chars
|
|
|
566 ;; or if comments can be nested, else the comment-end `}' would
|
|
|
567 ;; be turned into `}}}' where only the first ends the comment
|
|
|
568 ;; and the rest becomes bogus junk.
|
|
|
569 (multi (not (and comment-quote-nested
|
|
|
570 ;; comment-end is a single char
|
|
|
571 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
|
|
|
572 (if (not (symbolp n))
|
|
|
573 (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
|
|
|
574 ;; construct a regexp that would match anything from just S
|
|
|
575 ;; to any possible output of this function for any N.
|
|
|
576 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
|
|
|
577 lpad "") ;padding is not required
|
|
|
578 (regexp-quote s)
|
|
|
579 (when multi "+") ;the last char of S might be repeated
|
|
|
580 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
|
|
|
581 rpad "")))))) ;padding is not required
|
|
|
582
|
|
|
583 (defun comment-padleft (str &optional n)
|
|
|
584 "Construct a string composed of `comment-padding' plus STR.
|
|
|
585 It also adds N copies of the first non-whitespace chars of STR.
|
|
|
586 If STR already contains padding, the corresponding amount is
|
|
|
587 ignored from `comment-padding'.
|
|
|
588 N defaults to 0.
|
|
|
589 If N is `re', a regexp is returned instead, that would match
|
|
|
590 the string for any N."
|
|
|
591 (setq n (or n 0))
|
|
|
592 (when (and (stringp str) (not (string= "" str)))
|
|
|
593 ;; Only separate the left pad because we assume there is no right pad.
|
|
|
594 (string-match "\\`\\s-*" str)
|
|
|
595 (let ((s (substring str (match-end 0)))
|
|
|
596 (pad (concat (substring comment-padding
|
|
|
597 (min (- (match-end 0) (match-beginning 0))
|
|
|
598 (length comment-padding)))
|
|
|
599 (match-string 0 str)))
|
|
|
600 (c (aref str (match-end 0))) ;the first non-space char of STR
|
|
|
601 ;; We can only duplicate C if the comment-end has multiple chars
|
|
|
602 ;; or if comments can be nested, else the comment-end `}' would
|
|
|
603 ;; be turned into `}}}' where only the first ends the comment
|
|
|
604 ;; and the rest becomes bogus junk.
|
|
|
605 (multi (not (and comment-quote-nested
|
|
|
606 ;; comment-end is a single char
|
|
|
607 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
|
|
|
608 (if (not (symbolp n))
|
|
|
609 (concat pad (when multi (make-string n c)) s)
|
|
|
610 ;; Construct a regexp that would match anything from just S
|
|
|
611 ;; to any possible output of this function for any N.
|
|
|
612 ;; We match any number of leading spaces because this regexp will
|
|
|
613 ;; be used for uncommenting where we might want to remove
|
|
|
614 ;; uncomment markers with arbitrary leading space (because
|
|
|
615 ;; they were aligned).
|
|
|
616 (concat "\\s-*"
|
|
|
617 (if multi (concat (regexp-quote (string c)) "*"))
|
|
|
618 (regexp-quote s))))))
|
|
|
619
|
|
|
620 ;;;###autoload
|
|
|
621 (defun uncomment-region (beg end &optional arg)
|
|
|
622 "Uncomment each line in the BEG..END region.
|
|
|
623 The numeric prefix ARG can specify a number of chars to remove from the
|
|
|
624 comment markers."
|
|
|
625 (interactive "*r\nP")
|
|
|
626 (comment-normalize-vars)
|
|
|
627 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
|
|
|
628 (save-excursion
|
|
|
629 (goto-char beg)
|
|
|
630 (setq end (copy-marker end))
|
|
|
631
|
|
|
632 ;; XEmacs: Add the following clause
|
|
|
633
|
|
|
634 ;; if user didn't specify how many comments to remove, be smart
|
|
|
635 ;; and remove the minimal number that all lines have. that way,
|
|
|
636 ;; comments in a region of Elisp code that gets commented out will
|
|
|
637 ;; get put back correctly.
|
|
|
638 (if (null arg)
|
|
|
639 (let ((min-comments 999999))
|
|
|
640 (while (not (eobp))
|
|
|
641 (let ((this-comments 0))
|
|
|
642 (while (looking-at (regexp-quote comment-start))
|
|
|
643 (incf this-comments)
|
|
|
644 (forward-char (length comment-start)))
|
|
|
645 (if (and (> this-comments 0) (< this-comments min-comments))
|
|
|
646 (setq min-comments this-comments))
|
|
|
647 (forward-line 1)))
|
|
|
648 (if (< min-comments 999999)
|
|
|
649 (setq arg (list min-comments)))
|
|
|
650 (goto-char beg)))
|
|
|
651
|
|
|
652 (let ((numarg (prefix-numeric-value arg))
|
|
|
653 spt)
|
|
|
654 (while (and (< (point) end)
|
|
|
655 (setq spt (comment-search-forward end t)))
|
|
|
656 (let* ((ipt (point))
|
|
|
657 ;; Find the end of the comment.
|
|
|
658 (ept (progn
|
|
|
659 (goto-char spt)
|
|
|
660 (unless (comment-forward)
|
|
|
661 (error "Can't find the comment end"))
|
|
|
662 (point)))
|
|
|
663 (box nil)
|
|
|
664 (ccs comment-continue)
|
|
|
665 (srei (comment-padright ccs 're))
|
|
|
666 (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))))
|
|
|
667 (save-restriction
|
|
|
668 (narrow-to-region spt ept)
|
|
|
669 ;; Remove the comment-start.
|
|
|
670 (goto-char ipt)
|
|
|
671 (skip-syntax-backward " ")
|
|
|
672 ;; Check for special `=' used sometimes in comment-box.
|
|
|
673 (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}"))
|
|
|
674 (skip-chars-forward "="))
|
|
|
675 ;; A box-comment starts with a looong comment-start marker.
|
|
|
676 (when (> (- (point) (point-min) (length comment-start)) 7)
|
|
|
677 (setq box t))
|
|
|
678 (when (looking-at (regexp-quote comment-padding))
|
|
|
679 (goto-char (match-end 0)))
|
|
|
680 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
|
|
|
681 (goto-char (match-end 0)))
|
|
|
682 (if (null arg) (delete-region (point-min) (point))
|
|
|
683 (skip-syntax-backward " ")
|
|
|
684 (delete-char (- numarg)))
|
|
|
685
|
|
|
686 ;; Remove the end-comment (and leading padding and such).
|
|
|
687 (goto-char (point-max)) (comment-enter-backward)
|
|
|
688 ;; Check for special `=' used sometimes in comment-box.
|
|
|
689 (when (= (- (point-max) (point)) 1)
|
|
|
690 (let ((pos (point)))
|
|
|
691 ;; skip `=' but only if there are at least 7.
|
|
|
692 (when (> (skip-chars-backward "=") -7) (goto-char pos))))
|
|
|
693 (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
|
|
|
694 (when (and (bolp) (not (bobp))) (backward-char))
|
|
|
695 (if (null arg) (delete-region (point) (point-max))
|
|
|
696 (skip-syntax-forward " ")
|
|
|
697 (delete-char numarg)))
|
|
|
698
|
|
|
699 ;; Unquote any nested end-comment.
|
|
|
700 (comment-quote-nested comment-start comment-end t)
|
|
|
701
|
|
|
702 ;; Eliminate continuation markers as well.
|
|
|
703 (when sre
|
|
|
704 (let* ((cce (comment-string-reverse (or comment-continue
|
|
|
705 comment-start)))
|
|
|
706 (erei (and box (comment-padleft cce 're)))
|
|
|
707 (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))
|
|
|
708 (goto-char (point-min))
|
|
|
709 (while (progn
|
|
|
710 (if (and ere (re-search-forward
|
|
|
711 ere (line-end-position) t))
|
|
|
712 (replace-match "" t t nil (if (match-end 2) 2 1))
|
|
|
713 (setq ere nil))
|
|
|
714 (forward-line 1)
|
|
|
715 (re-search-forward sre (line-end-position) t))
|
|
|
716 (replace-match "" t t nil (if (match-end 2) 2 1)))))
|
|
|
717 ;; Go the the end for the next comment.
|
|
|
718 (goto-char (point-max)))))
|
|
|
719 (set-marker end nil))))
|
|
|
720
|
|
|
721 (defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
|
|
|
722 "Make the leading and trailing extra lines.
|
|
|
723 This is used for `extra-line' style (or `box' style if BLOCK is specified)."
|
|
|
724 (let ((eindent 0))
|
|
|
725 (if (not block)
|
|
|
726 ;; Try to match CS and CE's content so they align aesthetically.
|
|
|
727 (progn
|
|
|
728 (setq ce (comment-string-strip ce t t))
|
|
|
729 (when (string-match "\\(.+\\).*\n\\(.*?\\)\\1" (concat ce "\n" cs))
|
|
|
730 (setq eindent
|
|
|
731 (max (- (match-end 2) (match-beginning 2) (match-beginning 0))
|
|
|
732 0))))
|
|
|
733 ;; box comment
|
|
|
734 (let* ((width (- max-indent min-indent))
|
|
|
735 (s (concat cs "a=m" cce))
|
|
|
736 (e (concat ccs "a=m" ce))
|
|
|
737 (c (if (string-match ".*\\S-\\S-" cs)
|
|
|
738 (aref cs (1- (match-end 0))) ?=))
|
|
|
739 ; Huh? (_ (string-match "\\s-*a=m\\s-*" s))
|
|
|
740 (fill
|
|
|
741 (make-string (+ width (- (match-end 0)
|
|
|
742 (match-beginning 0) (length cs) 3)) c)))
|
|
|
743 (setq cs (replace-match fill t t s))
|
|
|
744 (string-match "\\s-*a=m\\s-*" e)
|
|
|
745 (setq ce (replace-match fill t t e))))
|
|
|
746 (cons (concat cs "\n" (make-string min-indent ? ) ccs)
|
|
|
747 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce))))
|
|
|
748
|
|
|
749 ;(def-edebug-spec comment-with-narrowing t)
|
|
|
750 (put 'comment-with-narrowing 'lisp-indent-function 2)
|
|
|
751 (defmacro comment-with-narrowing (beg end &rest body)
|
|
|
752 "Execute BODY with BEG..END narrowing.
|
|
|
753 Space is added (and then removed) at the beginning for the text's
|
|
|
754 indentation to be kept as it was before narrowing."
|
|
|
755 (let ((bindent (make-symbol "bindent")))
|
|
|
756 `(let ((,bindent (save-excursion (goto-char beg) (current-column))))
|
|
|
757 (save-restriction
|
|
|
758 (narrow-to-region beg end)
|
|
|
759 (goto-char (point-min))
|
|
|
760 (insert (make-string ,bindent ? ))
|
|
|
761 (prog1
|
|
|
762 (progn ,@body)
|
|
|
763 ;; remove the bindent
|
|
|
764 (save-excursion
|
|
|
765 (goto-char (point-min))
|
|
|
766 (when (looking-at " *")
|
|
|
767 (let ((n (min (- (match-end 0) (match-beginning 0)) ,bindent)))
|
|
|
768 (delete-char n)
|
|
|
769 (setq ,bindent (- ,bindent n))))
|
|
|
770 (end-of-line)
|
|
|
771 (let ((e (point)))
|
|
|
772 (beginning-of-line)
|
|
|
773 (while (and (> ,bindent 0) (re-search-forward " *" e t))
|
|
|
774 (let ((n (min ,bindent (- (match-end 0) (match-beginning 0) 1))))
|
|
|
775 (goto-char (match-beginning 0))
|
|
|
776 (delete-char n)
|
|
|
777 (setq ,bindent (- ,bindent n)))))))))))
|
|
|
778
|
|
|
779 (defun comment-region-internal (beg end cs ce
|
|
|
780 &optional ccs cce block lines indent)
|
|
|
781 "Comment region BEG..END.
|
|
|
782 CS and CE are the comment start resp end string.
|
|
|
783 CCS and CCE are the comment continuation strings for the start resp end
|
|
|
784 of lines (default to CS and CE).
|
|
|
785 BLOCK indicates that end of lines should be marked with either CCE, CE or CS
|
|
|
786 \(if CE is empty) and that those markers should be aligned.
|
|
|
787 LINES indicates that an extra lines will be used at the beginning and end
|
|
|
788 of the region for CE and CS.
|
|
|
789 INDENT indicates to put CS and CCS at the current indentation of the region
|
|
|
790 rather than at left margin."
|
|
|
791 ;;(assert (< beg end))
|
|
|
792 (let ((no-empty t))
|
|
|
793 ;; Sanitize CE and CCE.
|
|
|
794 (if (and (stringp ce) (string= "" ce)) (setq ce nil))
|
|
|
795 (if (and (stringp cce) (string= "" cce)) (setq cce nil))
|
|
|
796 ;; If CE is empty, multiline cannot be used.
|
|
|
797 (unless ce (setq ccs nil cce nil))
|
|
|
798 ;; Should we mark empty lines as well ?
|
|
|
799 (if (or ccs block lines) (setq no-empty nil))
|
|
|
800 ;; Make sure we have end-markers for BLOCK mode.
|
|
|
801 (when block (unless ce (setq ce (comment-string-reverse cs))))
|
|
|
802 ;; If BLOCK is not requested, we don't need CCE.
|
|
|
803 (unless block (setq cce nil))
|
|
|
804 ;; Continuation defaults to the same as CS and CE.
|
|
|
805 (unless ccs (setq ccs cs cce ce))
|
|
|
806
|
|
|
807 (save-excursion
|
|
|
808 (goto-char end)
|
|
|
809 ;; If the end is not at the end of a line and the comment-end
|
|
|
810 ;; is implicit (i.e. a newline), explicitly insert a newline.
|
|
|
811 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
|
|
|
812 (comment-with-narrowing beg end
|
|
|
813 (let ((min-indent (point-max))
|
|
|
814 (max-indent 0))
|
|
|
815 (goto-char (point-min))
|
|
|
816 ;; Quote any nested comment marker
|
|
|
817 (comment-quote-nested comment-start comment-end nil)
|
|
|
818
|
|
|
819 ;; Loop over all lines to find the needed indentations.
|
|
|
820 (goto-char (point-min))
|
|
|
821 (while
|
|
|
822 (progn
|
|
|
823 (unless (looking-at "[ \t]*$")
|
|
|
824 (setq min-indent (min min-indent (current-indentation))))
|
|
|
825 (end-of-line)
|
|
|
826 (setq max-indent (max max-indent (current-column)))
|
|
|
827 (not (or (eobp) (progn (forward-line) nil)))))
|
|
|
828
|
|
|
829 ;; Inserting ccs can change max-indent by (1- tab-width).
|
|
|
830 (setq max-indent
|
|
|
831 (+ max-indent (max (length cs) (length ccs)) tab-width -1))
|
|
|
832 (unless indent (setq min-indent 0))
|
|
|
833
|
|
|
834 ;; make the leading and trailing lines if requested
|
|
|
835 (when lines
|
|
|
836 (let ((csce
|
|
|
837 (comment-make-extra-lines
|
|
|
838 cs ce ccs cce min-indent max-indent block)))
|
|
|
839 (setq cs (car csce))
|
|
|
840 (setq ce (cdr csce))))
|
|
|
841
|
|
|
842 (goto-char (point-min))
|
|
|
843 ;; Loop over all lines from BEG to END.
|
|
|
844 (while
|
|
|
845 (progn
|
|
|
846 (unless (and no-empty (looking-at "[ \t]*$"))
|
|
|
847 (move-to-column min-indent t)
|
|
|
848 (insert cs) (setq cs ccs) ;switch to CCS after the first line
|
|
|
849 (end-of-line)
|
|
|
850 (if (eobp) (setq cce ce))
|
|
|
851 (when cce
|
|
|
852 (when block (move-to-column max-indent t))
|
|
|
853 (insert cce)))
|
|
|
854 (end-of-line)
|
|
|
855 (not (or (eobp) (progn (forward-line) nil))))))))))
|
|
|
856
|
|
|
857 ;;;###autoload
|
|
|
858 (defun comment-region (beg end &optional arg)
|
|
|
859 "Comment or uncomment each line in the region.
|
|
|
860 With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END.
|
|
|
861 Numeric prefix arg ARG means use ARG comment characters.
|
|
|
862 If ARG is negative, delete that many comment characters instead.
|
|
|
863 By default, comments start at the left margin, are terminated on each line,
|
|
|
864 even for syntax in which newline does not end the comment and blank lines
|
|
|
865 do not get comments. This can be changed with `comment-style'.
|
|
|
866
|
|
|
867 The strings used as comment starts are built from
|
|
|
868 `comment-start' without trailing spaces and `comment-padding'."
|
|
|
869 (interactive "*r\nP")
|
|
|
870 (comment-normalize-vars)
|
|
|
871 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
|
|
|
872 (let* ((numarg (prefix-numeric-value arg))
|
|
|
873 (add comment-add)
|
|
|
874 (style (cdr (assoc comment-style comment-styles)))
|
|
|
875 (lines (nth 2 style))
|
|
|
876 (block (nth 1 style))
|
|
|
877 (multi (nth 0 style)))
|
|
|
878 (save-excursion
|
|
|
879 ;; we use `chars' instead of `syntax' because `\n' might be
|
|
|
880 ;; of end-comment syntax rather than of whitespace syntax.
|
|
|
881 ;; sanitize BEG and END
|
|
|
882 (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
|
|
|
883 (setq beg (max beg (point)))
|
|
|
884 (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
|
|
|
885 (setq end (min end (point)))
|
|
|
886 (if (>= beg end) (error "Nothing to comment"))
|
|
|
887
|
|
|
888 ;; sanitize LINES
|
|
|
889 (setq lines
|
|
|
890 (and
|
|
|
891 lines ;; multi
|
|
|
892 (progn (goto-char beg) (beginning-of-line)
|
|
|
893 (skip-syntax-forward " ")
|
|
|
894 (>= (point) beg))
|
|
|
895 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
|
|
|
896 (<= (point) end))
|
|
|
897 (or (not (string= "" comment-end)) block)
|
|
|
898 (progn (goto-char beg) (search-forward "\n" end t)))))
|
|
|
899
|
|
|
900 ;; don't add end-markers just because the user asked for `block'
|
|
|
901 (unless (or lines (string= "" comment-end)) (setq block nil))
|
|
|
902
|
|
|
903 (cond
|
|
|
904 ((consp arg) (uncomment-region beg end))
|
|
|
905 ((< numarg 0) (uncomment-region beg end (- numarg)))
|
|
|
906 (t
|
|
|
907 (setq numarg (if (and (null arg) (= (length comment-start) 1))
|
|
|
908 add (1- numarg)))
|
|
|
909 (comment-region-internal
|
|
|
910 beg end
|
|
|
911 (let ((s (comment-padright comment-start numarg)))
|
|
|
912 (if (string-match comment-start-skip s) s
|
|
|
913 (comment-padright comment-start)))
|
|
|
914 (let ((s (comment-padleft comment-end numarg)))
|
|
|
915 (and s (if (string-match comment-end-skip s) s
|
|
|
916 (comment-padright comment-end))))
|
|
|
917 (if multi (comment-padright comment-continue numarg))
|
|
|
918 (if multi (comment-padleft (comment-string-reverse comment-continue) numarg))
|
|
|
919 block
|
|
|
920 lines
|
|
|
921 (nth 3 style))))))
|
|
|
922
|
|
|
923 (defun comment-box (beg end &optional arg)
|
|
|
924 "Comment out the BEG..END region, putting it inside a box.
|
|
|
925 The numeric prefix ARG specifies how many characters to add to begin- and
|
|
|
926 end- comment markers additionally to what `comment-add' already specifies."
|
|
|
927 (interactive "*r\np")
|
|
|
928 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
|
|
|
929 'box-multi 'box)))
|
|
|
930 (comment-region beg end (+ comment-add arg))))
|
|
|
931
|
|
|
932 ;;;###autoload
|
|
|
933 (defun comment-dwim (arg)
|
|
|
934 "Call the comment command you want (Do What I Mean).
|
|
|
935 If the region is active and `transient-mark-mode' is on, call
|
|
|
936 `comment-region' (unless it only consists of comments, in which
|
|
|
937 case it calls `uncomment-region').
|
|
|
938 Else, if the current line is empty, insert a comment and indent it.
|
|
|
939 Else if a prefix ARG is specified, call `comment-kill'.
|
|
|
940 Else, call `comment-indent'."
|
|
|
941 (interactive "*P")
|
|
|
942 (comment-normalize-vars)
|
|
|
943 (if (region-active-p) ;mark-active transient-mark-mode)
|
|
|
944 (let ((beg (min (point) (mark)))
|
|
|
945 (end (max (point) (mark))))
|
|
|
946 (if (save-excursion ;; check for already commented region
|
|
|
947 (goto-char beg)
|
|
|
948 (comment-forward (point-max))
|
|
|
949 (<= end (point)))
|
|
|
950 (uncomment-region beg end arg)
|
|
|
951 (comment-region beg end arg)))
|
|
|
952 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
|
|
|
953 ;; FIXME: If there's no comment to kill on this line and ARG is
|
|
|
954 ;; specified, calling comment-kill is not very clever.
|
|
|
955 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent))
|
|
|
956 (let ((add (if arg (prefix-numeric-value arg)
|
|
|
957 (if (= (length comment-start) 1) comment-add 0))))
|
|
|
958 ;; Some modes insist on keeping column 0 comment in column 0
|
|
|
959 ;; so we need to move away from it before inserting the comment.
|
|
|
960 (indent-according-to-mode)
|
|
|
961 (insert (comment-padright comment-start add))
|
|
|
962 (save-excursion
|
|
|
963 (unless (string= "" comment-end)
|
|
|
964 (insert (comment-padleft comment-end add)))
|
|
|
965 (indent-according-to-mode))))))
|
|
|
966
|
|
|
967 (defcustom comment-auto-fill-only-comments nil
|
|
|
968 "Non-nil means to only auto-fill inside comments.
|
|
|
969 This has no effect in modes that do not define a comment syntax."
|
|
|
970 :type 'boolean
|
|
|
971 :group 'comment)
|
|
|
972
|
|
|
973 ;;;###autoload
|
|
|
974 (defun comment-indent-new-line (&optional soft)
|
|
|
975 "Break line at point and indent, continuing comment if within one.
|
|
|
976 This indents the body of the continued comment
|
|
|
977 under the previous comment line.
|
|
|
978
|
|
|
979 This command is intended for styles where you write a comment per line,
|
|
|
980 starting a new comment (and terminating it if necessary) on each line.
|
|
|
981 If you want to continue one comment across several lines, use \\[newline-and-indent].
|
|
|
982
|
|
|
983 If a fill column is specified, it overrides the use of the comment column
|
|
|
984 or comment indentation.
|
|
|
985
|
|
|
986 The inserted newline is marked hard if variable `use-hard-newlines' is true,
|
|
|
987 unless optional argument SOFT is non-nil."
|
|
|
988 (interactive)
|
|
|
989 (comment-normalize-vars t)
|
|
|
990 (let (compos comin)
|
|
|
991 ;; If we are not inside a comment and we only auto-fill comments,
|
|
|
992 ;; don't do anything (unless no comment syntax is defined).
|
|
|
993 (unless (and comment-start
|
|
|
994 comment-auto-fill-only-comments
|
|
|
995 (not (save-excursion
|
|
|
996 (prog1 (setq compos (comment-beginning))
|
|
|
997 (setq comin (point))))))
|
|
|
998
|
|
|
999 ;; Now we know we should auto-fill.
|
|
|
1000 ;; XEmacs: next 3 lines from old version.
|
|
|
1001 (skip-chars-backward " \t")
|
|
|
1002 (if (featurep 'mule)
|
|
|
1003 (declare-fboundp (kinsoku-process)))
|
|
|
1004 (delete-horizontal-space)
|
|
|
1005 (if soft (insert-and-inherit ?\n) (newline 1))
|
|
|
1006 (if fill-prefix
|
|
|
1007 (progn
|
|
|
1008 (indent-to-left-margin)
|
|
|
1009 (insert-and-inherit fill-prefix))
|
|
|
1010
|
|
|
1011 ;;#### jhod: probably need to fix this for kinsoku processing
|
|
|
1012 ;; If necessary check whether we're inside a comment.
|
|
|
1013 (unless (or comment-multi-line compos (null comment-start))
|
|
|
1014 (save-excursion
|
|
|
1015 (backward-char)
|
|
|
1016 (setq compos (comment-beginning))
|
|
|
1017 (setq comin (point))))
|
|
|
1018
|
|
|
1019 ;; If we're not inside a comment, just try to indent.
|
|
|
1020 ;; #### XEmacs: the line `(if comcol' was changed as follows.
|
|
|
1021 ;; I'm leaving it out since who knows if it's applicable any more.
|
|
|
1022 ;; --ben
|
|
|
1023 ;; (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras.
|
|
|
1024 (if (not compos) (indent-according-to-mode)
|
|
|
1025 (let* ((comment-column
|
|
|
1026 ;; The continuation indentation should be somewhere between
|
|
|
1027 ;; the current line's indentation (plus 2 for good measure)
|
|
|
1028 ;; and the current comment's indentation, with a preference
|
|
|
1029 ;; for comment-column.
|
|
|
1030 (save-excursion
|
|
|
1031 (goto-char compos)
|
|
|
1032 (min (current-column) (max comment-column
|
|
|
1033 (+ 2 (current-indentation))))))
|
|
|
1034 (comstart (buffer-substring compos comin))
|
|
|
1035 (normalp
|
|
|
1036 (string-match (regexp-quote (comment-string-strip
|
|
|
1037 comment-start t t))
|
|
|
1038 comstart))
|
|
|
1039 (comment-end
|
|
|
1040 (if normalp comment-end
|
|
|
1041 ;; The comment starter is not the normal comment-start
|
|
|
1042 ;; so we can't just use comment-end.
|
|
|
1043 (save-excursion
|
|
|
1044 (goto-char compos)
|
|
|
1045 (if (not (comment-forward)) comment-end
|
|
|
1046 (comment-string-strip
|
|
|
1047 (buffer-substring
|
|
|
1048 (save-excursion (comment-enter-backward) (point))
|
|
|
1049 (point))
|
|
|
1050 nil t)))))
|
|
|
1051 (comment-start comstart)
|
|
|
1052 ;; Force comment-continue to be recreated from comment-start.
|
|
|
1053 ;; FIXME: wrong if comment-continue was set explicitly!
|
|
|
1054 (comment-continue nil))
|
|
|
1055 (insert-and-inherit ?\n)
|
|
|
1056 (forward-char -1)
|
|
|
1057 (comment-indent (cadr (assoc comment-style comment-styles)))
|
|
|
1058 (save-excursion
|
|
|
1059 (let ((pt (point)))
|
|
|
1060 (end-of-line)
|
|
|
1061 (let ((comend (buffer-substring pt (point))))
|
|
|
1062 ;; The 1+ is to make sure we delete the \n inserted above.
|
|
|
1063 (delete-region pt (1+ (point)))
|
|
|
1064 (beginning-of-line)
|
|
|
1065 (backward-char)
|
|
|
1066 (insert comend)
|
|
|
1067 (forward-char))))))))))
|
|
|
1068
|
|
|
1069 (provide 'newcomment)
|
|
|
1070
|
|
|
1071 ;;; newcomment.el ends here
|
