Mercurial > hg > xemacs-beta

comparison lisp/newcomment.el @ 1333:1b0339b048ce

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-03-02 09:38:37 by ben] To: xemacs-patches@xemacs.org PROBLEMS: Include nt/PROBLEMS and update. Add note about incremental linking badness. cmdloop.el, custom.el, dumped-lisp.el, files.el, keydefs.el, keymap.el, lisp-mode.el, make-docfile.el, replace.el, simple.el, subr.el, view-less.el, wid-edit.el: Lots of syncing with FSF 21.2. Use if-fboundp in wid-edit.el. New file newcomment.el from FSF. internals/internals.texi: Fix typo. (Build-Time Dependencies): New node. PROBLEMS: Delete. config.inc.samp, xemacs.mak: Eliminate HAVE_VC6, use SUPPORT_EDIT_AND_CONTINUE in its place. No incremental linking unless SUPPORT_EDIT_AND_CONTINUE, since it can cause nasty crashes in pdump. Put warnings about this in config.inc.samp. Report the full compile flags used for src and lib-src in the Installation output. alloc.c, lisp.h, ralloc.c, regex.c: Use ALLOCA() in regex.c to avoid excessive stack allocation. Also fix subtle problem with REL_ALLOC() -- any call to malloc() (direct or indirect) may relocate rel-alloced data, causing buffer text to shift. After any such call, regex must update all its pointers to such data. Add a system, when ERROR_CHECK_MALLOC, whereby regex.c indicates all the places it is prepared to handle malloc()/realloc()/free(), and any calls anywhere in XEmacs outside of this will trigger an abort. alloc.c, dialog-msw.c, eval.c, event-stream.c, general-slots.h, insdel.c, lisp.h, menubar-msw.c, menubar-x.c: Change *run_hook*_trapping_problems to take a warning class, not a string. Factor out code to issue warnings, add flag to call_trapping_problems() to postpone warning issue, and make *run_hook*_trapping_problems issue their own warnings tailored to the hook, postponed in the case of safe_run_hook_trapping_problems() so that the appropriate message can be issued about resetting to nil only when not `quit'. Make record_unwind_protect_restoring_int() non-static. dumper.c: Issue notes about incremental linking problems under Windows. fileio.c: Mule-ize encrypt/decrypt-string code. text.h: Spacing changes.
author ben
date Sun, 02 Mar 2003 09:38:54 +0000
parents
children ce294639d321
comparison
equal deleted inserted replaced
1332:6aa23bb3da6b 1333:1b0339b048ce
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