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