Mercurial > hg > xemacs-beta
annotate lisp/newcomment.el @ 4677:8f1ee2d15784
Support full Common Lisp multiple values in C.
lisp/ChangeLog
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el :
Update this file to support full C-level multiple values. This
involves:
-- Four new bytecodes, and special compiler functions to compile
multiple-value-call, multiple-value-list-internal, values,
values-list, and, since it now needs to pass back multiple values
and is a special form, throw.
-- There's a new compiler variable, byte-compile-checks-on-load,
which is a list of forms that are evaluated at the very start of a
file, with an error thrown if any of them give nil.
-- The header is now inserted *after* compilation, giving a chance
for the compilation process to influence what those checks
are. There is still a check done before compilation for non-ASCII
characters, to try to turn off dynamic docstrings if appopriate,
in `byte-compile-maybe-reset-coding'.
Space is reserved for checks; comments describing the version of
the byte compiler generating the file are inserted if space
remains for them.
* bytecomp.el (byte-compile-version):
Update this, we're a newer version of the byte compiler.
* byte-optimize.el (byte-optimize-funcall):
Correct a comment.
* bytecomp.el (byte-compile-lapcode):
Discard the arg with byte-multiple-value-call.
* bytecomp.el (byte-compile-checks-and-comments-space):
New variable, describe how many octets to reserve for checks at
the start of byte-compiled files.
* cl-compat.el:
Remove the fake multiple-value implementation. Have the functions
that use it use the real multiple-value implementation instead.
* cl-macs.el (cl-block-wrapper, cl-block-throw):
Revise the byte-compile properties of these symbols to work now
we've made throw into a special form; keep the byte-compile
properties as anonymous lambdas, since we don't have docstrings
for them.
* cl-macs.el (multiple-value-bind, multiple-value-setq)
(multiple-value-list, nth-value):
Update these functions to work with the C support for multiple
values.
* cl-macs.el (values):
Modify the setf handler for this to call
#'multiple-value-list-internal appropriately.
* cl-macs.el (cl-setf-do-store):
If the store form is a cons, treat it specially as wrapping the
store value.
* cl.el (cl-block-wrapper):
Make this an alias of #'and, not #'identity, since it needs to
pass back multiple values.
* cl.el (multiple-value-apply):
We no longer support this, mark it obsolete.
* lisp-mode.el (eval-interactive-verbose):
Remove a useless space in the docstring.
* lisp-mode.el (eval-interactive):
Update this function and its docstring. It now passes back a list,
basically wrapping any eval calls with multiple-value-list. This
allows multiple values to be printed by default in *scratch*.
* lisp-mode.el (prin1-list-as-multiple-values):
New function, printing a list as multiple values in the manner of
Bruno Haible's clisp, separating each entry with " ;\n".
* lisp-mode.el (eval-last-sexp):
Call #'prin1-list-as-multiple-values on the return value of
#'eval-interactive.
* lisp-mode.el (eval-defun):
Call #'prin1-list-as-multiple-values on the return value of
#'eval-interactive.
* mouse.el (mouse-eval-sexp):
Deal with lists corresponding to multiple values from
#'eval-interactive. Call #'cl-prettyprint, which is always
available, instead of sometimes calling #'pprint and sometimes
falling back to prin1.
* obsolete.el (obsolete-throw):
New function, called from eval.c when #'funcall encounters an
attempt to call #'throw (now a special form) as a function. Only
needed for compatibility with 21.4 byte-code.
man/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* cl.texi (Organization):
Remove references to the obsolete multiple-value emulating code.
src/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* bytecode.c (enum Opcode /* Byte codes */):
Add four new bytecodes, to deal with multiple values.
(POP_WITH_MULTIPLE_VALUES): New macro.
(POP): Modify this macro to ignore multiple values.
(DISCARD_PRESERVING_MULTIPLE_VALUES): New macro.
(DISCARD): Modify this macro to ignore multiple values.
(TOP_WITH_MULTIPLE_VALUES): New macro.
(TOP_ADDRESS): New macro.
(TOP): Modify this macro to ignore multiple values.
(TOP_LVALUE): New macro.
(Bcall): Ignore multiple values where appropriate.
(Breturn): Pass back multiple values.
(Bdup): Preserve multiple values.
Use TOP_LVALUE with most bytecodes that assign anything to
anything.
(Bbind_multiple_value_limits, Bmultiple_value_call,
Bmultiple_value_list_internal, Bthrow): Implement the new
bytecodes.
(Bgotoifnilelsepop, Bgotoifnonnilelsepop, BRgotoifnilelsepop,
BRgotoifnonnilelsepop):
Discard any multiple values.
* callint.c (Fcall_interactively):
Ignore multiple values when calling #'eval, in two places.
* device-x.c (x_IO_error_handler):
* macros.c (pop_kbd_macro_event):
* eval.c (Fsignal):
* eval.c (flagged_a_squirmer):
Call throw_or_bomb_out, not Fthrow, now that the latter is a
special form.
* eval.c:
Make Qthrow, Qobsolete_throw available as symbols.
Provide multiple_value_current_limit, multiple-values-limit (the
latter as specified by Common Lisp.
* eval.c (For):
Ignore multiple values when comparing with Qnil, but pass any
multiple values back for the last arg.
* eval.c (Fand):
Ditto.
* eval.c (Fif):
Ignore multiple values when examining the result of the
condition.
* eval.c (Fcond):
Ignore multiple values when comparing what the clauses give, but
pass them back if a clause gave non-nil.
* eval.c (Fprog2):
Never pass back multiple values.
* eval.c (FletX, Flet):
Ignore multiple when evaluating what exactly symbols should be
bound to.
* eval.c (Fwhile):
Ignore multiple values when evaluating the test.
* eval.c (Fsetq, Fdefvar, Fdefconst):
Ignore multiple values.
* eval.c (Fthrow):
Declare this as a special form; ignore multiple values for TAG,
preserve them for VALUE.
* eval.c (throw_or_bomb_out):
Make this available to other files, now Fthrow is a special form.
* eval.c (Feval):
Ignore multiple values when calling a compiled function, a
non-special-form subr, or a lambda expression.
* eval.c (Ffuncall):
If we attempt to call #'throw (now a special form) as a function,
don't error, call #'obsolete-throw instead.
* eval.c (make_multiple_value, multiple_value_aset)
(multiple_value_aref, print_multiple_value, mark_multiple_value)
(size_multiple_value):
Implement the multiple_value type. Add a long comment describing
our implementation.
* eval.c (bind_multiple_value_limits):
New function, used by the bytecode and by #'multiple-value-call,
#'multiple-value-list-internal.
* eval.c (multiple_value_call):
New function, used by the bytecode and #'multiple-value-call.
* eval.c (Fmultiple_value_call):
New special form.
* eval.c (multiple_value_list_internal):
New function, used by the byte code and
#'multiple-value-list-internal.
* eval.c (Fmultiple_value_list_internal, Fmultiple_value_prog1):
New special forms.
* eval.c (Fvalues, Fvalues_list):
New Lisp functions.
* eval.c (values2):
New function, for C code returning multiple values.
* eval.c (syms_of_eval):
Make our new Lisp functions and symbols available.
* eval.c (multiple-values-limit):
Make this available to Lisp.
* event-msw.c (dde_eval_string):
* event-stream.c (execute_help_form):
* glade.c (connector):
* glyphs-widget.c (glyph_instantiator_to_glyph):
* glyphs.c (evaluate_xpm_color_symbols):
* gui-x.c (wv_set_evalable_slot, button_item_to_widget_value):
* gui.c (gui_item_value, gui_item_display_flush_left):
* lread.c (check_if_suppressed):
* menubar-gtk.c (menu_convert, menu_descriptor_to_widget_1):
* menubar-msw.c (populate_menu_add_item):
* print.c (Fwith_output_to_temp_buffer):
* symbols.c (Fsetq_default):
Ignore multiple values when calling Feval.
* symeval.h:
Add the header declarations necessary for the multiple-values
implementation.
* inline.c:
#include symeval.h, now that it has some inline functions.
* lisp.h:
Update Fthrow's declaration. Make throw_or_bomb_out available to
all files.
* lrecord.h (enum lrecord_type):
Add the multiple_value type here.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 16 Aug 2009 20:55:49 +0100 |
| parents | 1e2fc51563a5 |
| children | f00192e1cd49 308d34e9f07d |
| rev | line source |
|---|---|
| 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 | |
| 9 ;; This file is part of GNU Emacs. | |
| 10 | |
| 11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 12 ;; it under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 ;; GNU General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 2511 | 26 ;;; Synched up with: FSF 21.3. |
| 27 | |
| 1333 | 28 ;;; Commentary: |
| 29 | |
| 30 ;; A replacement for simple.el's comment-related functions. | |
| 31 | |
| 32 ;;; Bugs: | |
| 33 | |
| 2511 | 34 ;; - boxed comments in Perl are not properly uncommented because they are |
| 35 ;; uncommented one-line at a time. | |
| 36 ;; - nested comments in sgml-mode are not properly quoted. | |
| 1333 | 37 ;; - single-char nestable comment-start can only do the "\\s<+" stuff |
| 38 ;; if the corresponding closing marker happens to be right. | |
| 39 ;; - uncomment-region with a numeric argument can render multichar | |
| 40 ;; comment markers invalid. | |
| 41 ;; - comment-indent or comment-region when called inside a comment | |
| 42 ;; will happily break the surrounding comment. | |
| 43 ;; - comment-quote-nested will not (un)quote properly all nested comment | |
| 44 ;; markers if there are more than just comment-start and comment-end. | |
| 45 ;; For example, in Pascal where {...*) and (*...} are possible. | |
| 46 | |
| 47 ;;; Todo: | |
| 48 | |
| 2511 | 49 ;; - rebox.el-style refill. |
| 50 ;; - quantized steps in comment-alignment. | |
| 51 ;; - try to align tail comments. | |
| 52 ;; - check what c-comment-line-break-function has to say. | |
| 53 ;; - spill auto-fill of comments onto the end of the next line. | |
| 1333 | 54 ;; - uncomment-region with a consp (for blocks) or somehow make the |
| 2511 | 55 ;; deletion of continuation markers less dangerous. |
| 56 ;; - drop block-comment-<foo> unless it's really used. | |
| 57 ;; - uncomment-region on a subpart of a comment. | |
| 58 ;; - support gnu-style "multi-line with space in continue". | |
| 1333 | 59 ;; - somehow allow comment-dwim to use the region even if transient-mark-mode |
| 60 ;; is not turned on. | |
| 61 | |
| 62 ;; - when auto-filling a comment, try to move the comment to the left | |
| 63 ;; rather than break it (if possible). | |
| 64 ;; - sometimes default the comment-column to the same | |
| 65 ;; one used on the preceding line(s). | |
| 66 | |
| 67 ;;; Code: | |
| 68 | |
| 69 ;;;###autoload | |
| 70 (defalias 'indent-for-comment 'comment-indent) | |
| 71 ;;;###autoload | |
| 72 (defalias 'set-comment-column 'comment-set-column) | |
| 73 ;;;###autoload | |
| 74 (defalias 'kill-comment 'comment-kill) | |
| 75 ;;;###autoload | |
| 76 (defalias 'indent-new-comment-line 'comment-indent-new-line) | |
| 77 | |
| 78 (defgroup comment nil | |
| 79 "Indenting and filling of comments." | |
| 80 :prefix "comment-" | |
| 81 :version "21.1" | |
| 82 :group 'fill) | |
| 83 | |
| 84 (defvar comment-use-syntax 'undecided | |
| 85 "Non-nil if syntax-tables can be used instead of regexps. | |
| 86 Can also be `undecided' which means that a somewhat expensive test will | |
| 87 be used to try to determine whether syntax-tables should be trusted | |
| 88 to understand comments or not in the given buffer. | |
| 89 Major modes should set this variable.") | |
| 90 | |
| 2511 | 91 (defcustom comment-fill-column nil |
| 92 "Column to use for `comment-indent'. If nil, use `fill-column' instead." | |
| 93 :type '(choice (const nil) integer)) | |
| 94 | |
| 1333 | 95 ;;;###autoload |
| 96 (defcustom comment-column 32 | |
| 97 "*Column to indent right-margin comments to. | |
| 98 Each mode establishes a different default value for this variable; you | |
| 2511 | 99 can set the value for a particular mode using that mode's hook. |
| 100 Comments might be indented to a value smaller than this in order | |
| 101 not to go beyond `comment-fill-column'." | |
| 102 :type 'integer) | |
| 1333 | 103 (make-variable-buffer-local 'comment-column) |
| 104 | |
| 105 ;;;###autoload | |
| 106 (defvar comment-start nil | |
| 107 "*String to insert to start a new comment, or nil if no comment syntax.") | |
| 108 | |
| 109 ;;;###autoload | |
| 110 (defvar comment-start-skip nil | |
| 111 "*Regexp to match the start of a comment plus everything up to its body. | |
| 112 If there are any \\(...\\) pairs, the comment delimiter text is held to begin | |
| 113 at the place matched by the close of the first pair.") | |
| 114 | |
| 115 ;;;###autoload | |
| 116 (defvar comment-end-skip nil | |
| 117 "Regexp to match the end of a comment plus everything up to its body.") | |
| 118 | |
| 119 ;;;###autoload | |
| 120 (defvar comment-end "" | |
| 121 "*String to insert to end a new comment. | |
| 122 Should be an empty string if comments are terminated by end-of-line.") | |
| 123 | |
| 124 ;;;###autoload | |
| 125 (defvar comment-indent-function 'comment-indent-default | |
| 126 "Function to compute desired indentation for a comment. | |
| 127 This function is called with no args with point at the beginning of | |
| 128 the comment's starting delimiter and should return either the desired | |
| 129 column indentation or nil. | |
| 130 If nil is returned, indentation is delegated to `indent-according-to-mode'.") | |
| 131 | |
| 132 (defvar block-comment-start nil) | |
| 133 (defvar block-comment-end nil) | |
| 134 | |
| 135 (defvar comment-quote-nested t | |
| 136 "Non-nil if nested comments should be quoted. | |
| 137 This should be locally set by each major mode if needed.") | |
| 138 | |
| 139 (defvar comment-continue nil | |
| 140 "Continuation string to insert for multiline comments. | |
| 141 This string will be added at the beginning of each line except the very | |
| 142 first one when commenting a region with a commenting style that allows | |
| 143 comments to span several lines. | |
| 144 It should generally have the same length as `comment-start' in order to | |
| 145 preserve indentation. | |
| 146 If it is nil a value will be automatically derived from `comment-start' | |
| 147 by replacing its first character with a space.") | |
| 148 | |
| 149 (defvar comment-add 0 | |
| 150 "How many more comment chars should be inserted by `comment-region'. | |
| 151 This determines the default value of the numeric argument of `comment-region'. | |
| 152 This should generally stay 0, except for a few modes like Lisp where | |
| 153 it can be convenient to set it to 1 so that regions are commented with | |
| 154 two semi-colons.") | |
| 155 | |
| 156 (defconst comment-styles | |
| 157 '((plain . (nil nil nil nil)) | |
| 158 (indent . (nil nil nil t)) | |
| 159 (aligned . (nil t nil t)) | |
| 160 (multi-line . (t nil nil t)) | |
| 161 (extra-line . (t nil t t)) | |
| 162 (box . (nil t t t)) | |
| 163 (box-multi . (t t t t))) | |
| 164 "Possible comment styles of the form (STYLE . (MULTI ALIGN EXTRA INDENT)). | |
| 165 STYLE should be a mnemonic symbol. | |
| 166 MULTI specifies that comments are allowed to span multiple lines. | |
| 167 ALIGN specifies that the `comment-end' markers should be aligned. | |
| 168 EXTRA specifies that an extra line should be used before and after the | |
| 169 region to comment (to put the `comment-end' and `comment-start'). | |
| 170 INDENT specifies that the `comment-start' markers should not be put at the | |
| 171 left margin but at the current indentation of the region to comment.") | |
| 172 | |
| 173 ;;;###autoload | |
| 174 (defcustom comment-style 'plain | |
| 175 "*Style to be used for `comment-region'. | |
| 176 See `comment-styles' for a list of available styles." | |
| 177 :type (if (boundp 'comment-styles) | |
| 178 `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles)) | |
| 179 'symbol)) | |
| 180 | |
| 181 ;;;###autoload | |
| 182 (defcustom comment-padding " " | |
| 183 "Padding string that `comment-region' puts between comment chars and text. | |
| 184 Can also be an integer which will be automatically turned into a string | |
| 185 of the corresponding number of spaces. | |
| 186 | |
| 187 Extra spacing between the comment characters and the comment text | |
| 2511 | 188 makes the comment easier to read. Default is 1. nil means 0." |
| 1333 | 189 :type '(choice string integer (const nil))) |
| 190 | |
| 191 ;;;###autoload | |
| 192 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill | |
| 193 "*Non-nil means \\[indent-new-comment-line] should continue same comment | |
| 194 on new line, with no new terminator or starter. | |
| 195 This is obsolete because you might as well use \\[newline-and-indent]." | |
| 2511 | 196 :type 'boolean) |
| 1333 | 197 |
| 198 ;;;; | |
| 199 ;;;; Helpers | |
| 200 ;;;; | |
| 201 | |
| 202 (defun comment-string-strip (str beforep afterp) | |
| 203 "Strip STR of any leading (if BEFOREP) and/or trailing (if AFTERP) space." | |
| 204 (string-match (concat "\\`" (if beforep "\\s-*") | |
| 205 "\\(.*?\\)" (if afterp "\\s-*\n?") | |
| 206 "\\'") str) | |
| 207 (match-string 1 str)) | |
| 208 | |
| 209 (defun comment-string-reverse (s) | |
| 210 "Return the mirror image of string S, without any trailing space." | |
| 211 (comment-string-strip (concat (nreverse (string-to-list s))) nil t)) | |
| 212 | |
| 2511 | 213 ;;;###autoload |
| 1333 | 214 (defun comment-normalize-vars (&optional noerror) |
| 215 (if (not comment-start) (or noerror (error "No comment syntax is defined")) | |
| 216 ;; comment-use-syntax | |
| 217 (when (eq comment-use-syntax 'undecided) | |
| 218 (set (make-local-variable 'comment-use-syntax) | |
| 219 (let ((st (syntax-table)) | |
| 220 (cs comment-start) | |
| 221 (ce (if (string= "" comment-end) "\n" comment-end))) | |
| 222 ;; Try to skip over a comment using forward-comment | |
| 223 ;; to see if the syntax tables properly recognize it. | |
| 224 (with-temp-buffer | |
| 225 (set-syntax-table st) | |
| 226 (insert cs " hello " ce) | |
| 227 (goto-char (point-min)) | |
| 228 (and (forward-comment 1) (eobp)))))) | |
| 229 ;; comment-padding | |
| 230 (unless comment-padding (setq comment-padding 0)) | |
| 231 (when (integerp comment-padding) | |
| 232 (setq comment-padding (make-string comment-padding ? ))) | |
| 233 ;; comment markers | |
| 234 ;;(setq comment-start (comment-string-strip comment-start t nil)) | |
| 235 ;;(setq comment-end (comment-string-strip comment-end nil t)) | |
| 236 ;; comment-continue | |
| 237 (unless (or comment-continue (string= comment-end "")) | |
| 238 (set (make-local-variable 'comment-continue) | |
| 239 (concat (if (string-match "\\S-\\S-" comment-start) " " "|") | |
| 2511 | 240 (substring comment-start 1))) |
| 241 ;; Hasn't been necessary yet. | |
| 242 ;; (unless (string-match comment-start-skip comment-continue) | |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
243 ;; (kill-local-variable 'comment-continue)) |
| 2511 | 244 ) |
| 1333 | 245 ;; comment-skip regexps |
| 2511 | 246 (unless (and comment-start-skip |
| 247 ;; In case comment-start has changed since last time. | |
| 248 (string-match comment-start-skip comment-start)) | |
| 1333 | 249 (set (make-local-variable 'comment-start-skip) |
| 250 (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|" | |
| 251 (regexp-quote (comment-string-strip comment-start t t)) | |
| 252 ;; Let's not allow any \s- but only [ \t] since \n | |
| 253 ;; might be both a comment-end marker and \s-. | |
| 254 "+\\)[ \t]*"))) | |
| 2511 | 255 (unless (and comment-end-skip |
| 256 ;; In case comment-end has changed since last time. | |
| 257 (string-match comment-end-skip comment-end)) | |
| 1333 | 258 (let ((ce (if (string= "" comment-end) "\n" |
| 259 (comment-string-strip comment-end t t)))) | |
| 260 (set (make-local-variable 'comment-end-skip) | |
| 261 ;; We use [ \t] rather than \s- because we don't want to | |
| 262 ;; remove ^L in C mode when uncommenting. | |
| 263 (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+") | |
| 264 "\\|" (regexp-quote (substring ce 0 1)) | |
| 265 (if (and comment-quote-nested (<= (length ce) 1)) "" "+") | |
| 266 (regexp-quote (substring ce 1)) | |
| 267 "\\)")))))) | |
| 2511 | 268 |
| 1333 | 269 (defun comment-quote-re (str unp) |
| 270 (concat (regexp-quote (substring str 0 1)) | |
| 271 "\\\\" (if unp "+" "*") | |
| 272 (regexp-quote (substring str 1)))) | |
| 273 | |
| 274 (defun comment-quote-nested (cs ce unp) | |
| 275 "Quote or unquote nested comments. | |
| 276 If UNP is non-nil, unquote nested comment markers." | |
| 277 (setq cs (comment-string-strip cs t t)) | |
| 278 (setq ce (comment-string-strip ce t t)) | |
| 279 (when (and comment-quote-nested (> (length ce) 0)) | |
| 280 (let ((re (concat (comment-quote-re ce unp) | |
| 281 "\\|" (comment-quote-re cs unp)))) | |
| 282 (goto-char (point-min)) | |
| 283 (while (re-search-forward re nil t) | |
| 284 (goto-char (match-beginning 0)) | |
| 285 (forward-char 1) | |
| 286 (if unp (delete-char 1) (insert "\\")) | |
| 287 (when (= (length ce) 1) | |
| 288 ;; If the comment-end is a single char, adding a \ after that | |
| 289 ;; "first" char won't deactivate it, so we turn such a CE | |
| 290 ;; into !CS. I.e. for pascal, we turn } into !{ | |
| 291 (if (not unp) | |
| 292 (when (string= (match-string 0) ce) | |
| 293 (replace-match (concat "!" cs) t t)) | |
| 294 (when (and (< (point-min) (match-beginning 0)) | |
| 295 (string= (buffer-substring (1- (match-beginning 0)) | |
| 296 (1- (match-end 0))) | |
| 297 (concat "!" cs))) | |
| 298 (backward-char 2) | |
| 299 (delete-char (- (match-end 0) (match-beginning 0))) | |
| 300 (insert ce)))))))) | |
| 301 | |
| 302 ;;;; | |
| 303 ;;;; Navigation | |
| 304 ;;;; | |
| 305 | |
| 306 (defun comment-search-forward (limit &optional noerror) | |
| 307 "Find a comment start between point and LIMIT. | |
| 308 Moves point to inside the comment and returns the position of the | |
| 309 comment-starter. If no comment is found, moves point to LIMIT | |
| 310 and raises an error or returns nil of NOERROR is non-nil." | |
| 311 (if (not comment-use-syntax) | |
| 312 (if (re-search-forward comment-start-skip limit noerror) | |
| 313 (or (match-end 1) (match-beginning 0)) | |
| 314 (goto-char limit) | |
| 315 (unless noerror (error "No comment"))) | |
| 316 (let* ((pt (point)) | |
| 317 ;; Assume (at first) that pt is outside of any string. | |
| 318 (s (parse-partial-sexp pt (or limit (point-max)) nil nil nil t))) | |
| 319 (when (and (nth 8 s) (nth 3 s)) | |
| 320 ;; The search ended inside a string. Try to see if it | |
| 321 ;; works better when we assume that pt is inside a string. | |
| 322 (setq s (parse-partial-sexp | |
| 323 pt (or limit (point-max)) nil nil | |
| 324 (list nil nil nil (nth 3 s) nil nil nil nil) | |
| 325 t))) | |
| 326 (if (not (and (nth 8 s) (not (nth 3 s)))) | |
| 327 (unless noerror (error "No comment")) | |
| 328 ;; We found the comment. | |
| 329 (let ((pos (point)) | |
| 330 (start (nth 8 s)) | |
| 331 (bol (line-beginning-position)) | |
| 332 (end nil)) | |
| 333 (while (and (null end) (>= (point) bol)) | |
| 334 (if (looking-at comment-start-skip) | |
| 335 (setq end (min (or limit (point-max)) (match-end 0))) | |
| 336 (backward-char))) | |
| 337 (goto-char (or end pos)) | |
| 338 start))))) | |
| 339 | |
| 340 (defun comment-search-backward (&optional limit noerror) | |
| 341 "Find a comment start between LIMIT and point. | |
| 342 Moves point to inside the comment and returns the position of the | |
| 343 comment-starter. If no comment is found, moves point to LIMIT | |
| 344 and raises an error or returns nil of NOERROR is non-nil." | |
| 345 ;; FIXME: If a comment-start appears inside a comment, we may erroneously | |
| 346 ;; stop there. This can be rather bad in general, but since | |
| 347 ;; comment-search-backward is only used to find the comment-column (in | |
| 348 ;; comment-set-column) and to find the comment-start string (via | |
| 349 ;; comment-beginning) in indent-new-comment-line, it should be harmless. | |
| 350 (if (not (re-search-backward comment-start-skip limit t)) | |
| 351 (unless noerror (error "No comment")) | |
| 352 (beginning-of-line) | |
| 353 (let* ((end (match-end 0)) | |
| 354 (cs (comment-search-forward end t)) | |
| 355 (pt (point))) | |
| 356 (if (not cs) | |
| 357 (progn (beginning-of-line) | |
| 358 (comment-search-backward limit noerror)) | |
| 359 (while (progn (goto-char cs) | |
| 360 (comment-forward) | |
| 361 (and (< (point) end) | |
| 362 (setq cs (comment-search-forward end t)))) | |
| 363 (setq pt (point))) | |
| 364 (goto-char pt) | |
| 365 cs)))) | |
| 366 | |
| 367 (defun comment-beginning () | |
| 368 "Find the beginning of the enclosing comment. | |
| 369 Returns nil if not inside a comment, else moves point and returns | |
| 370 the same as `comment-search-forward'." | |
| 371 ;; HACK ATTACK! | |
| 372 ;; We should really test `in-string-p' but that can be expensive. | |
| 373 (unless (eq (get-text-property (point) 'face) 'font-lock-string-face) | |
| 374 (let ((pt (point)) | |
| 375 (cs (comment-search-backward nil t))) | |
| 376 (when cs | |
| 377 (if (save-excursion | |
| 378 (goto-char cs) | |
| 379 (and | |
| 380 ;; For modes where comment-start and comment-end are the same, | |
| 381 ;; the search above may have found a `ce' rather than a `cs'. | |
| 382 (or (not (looking-at comment-end-skip)) | |
| 383 ;; Maybe font-lock knows that it's a `cs'? | |
| 384 (eq (get-text-property (match-end 0) 'face) | |
| 385 'font-lock-comment-face) | |
| 386 (unless (eq (get-text-property (point) 'face) | |
| 387 'font-lock-comment-face) | |
| 388 ;; Let's assume it's a `cs' if we're on the same line. | |
| 389 (>= (line-end-position) pt))) | |
| 390 ;; Make sure that PT is not past the end of the comment. | |
| 391 (if (comment-forward 1) (> (point) pt) (eobp)))) | |
| 392 cs | |
| 393 (goto-char pt) | |
| 394 nil))))) | |
| 395 | |
| 396 (defun comment-forward (&optional n) | |
| 397 "Skip forward over N comments. | |
| 398 Just like `forward-comment' but only for positive N | |
| 399 and can use regexps instead of syntax." | |
| 400 (setq n (or n 1)) | |
| 401 (if (< n 0) (error "No comment-backward") | |
| 402 (if comment-use-syntax (forward-comment n) | |
| 403 (while (> n 0) | |
| 404 (setq n | |
| 405 (if (or (forward-comment 1) | |
| 406 (and (looking-at comment-start-skip) | |
| 407 (goto-char (match-end 0)) | |
| 408 (re-search-forward comment-end-skip nil 'move))) | |
| 409 (1- n) -1))) | |
| 410 (= n 0)))) | |
| 411 | |
| 412 (defun comment-enter-backward () | |
| 413 "Move from the end of a comment to the end of its content. | |
| 414 Point is assumed to be just at the end of a comment." | |
| 415 (if (bolp) | |
| 416 ;; comment-end = "" | |
| 417 (progn (backward-char) (skip-syntax-backward " ")) | |
| 418 (let ((end (point))) | |
| 419 (beginning-of-line) | |
| 420 (save-restriction | |
| 421 (narrow-to-region (point) end) | |
| 422 (if (re-search-forward (concat comment-end-skip "\\'") nil t) | |
| 423 (goto-char (match-beginning 0)) | |
| 424 ;; comment-end-skip not found probably because it was not set right. | |
| 425 ;; Since \\s> should catch the single-char case, we'll blindly | |
| 426 ;; assume we're at the end of a two-char comment-end. | |
| 427 (goto-char (point-max)) | |
| 428 (backward-char 2) | |
| 429 (skip-chars-backward (string (char-after))) | |
| 430 (skip-syntax-backward " ")))))) | |
| 431 | |
| 432 ;;;; | |
| 433 ;;;; Commands | |
| 434 ;;;; | |
| 435 | |
| 436 ;;;###autoload | |
| 437 | |
| 438 ;; #### XEmacs had this: in place of just (current-column) | |
| 439 ; (defconst comment-indent-function | |
| 440 ; ;; XEmacs - add at least one space after the end of the text on the | |
| 441 ; ;; current line... | |
| 442 ; (lambda () | |
| 443 ; (save-excursion | |
| 444 ; (beginning-of-line) | |
| 445 ; (let ((eol (save-excursion (end-of-line) (point)))) | |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
446 ; (and comment-start-skip |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
447 ; (re-search-forward comment-start-skip eol t) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
448 ; (setq eol (match-beginning 0))) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
449 ; (goto-char eol) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
450 ; (skip-chars-backward " \t") |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
451 ; (max comment-column (1+ (current-column)))))) |
| 1333 | 452 ; "Function to compute desired indentation for a comment. |
| 453 ; This function is called with no args with point at the beginning of | |
| 454 ; the comment's starting delimiter.") | |
| 455 | |
| 456 (defun comment-indent-default () | |
| 457 "Default for `comment-indent-function'." | |
| 458 (if (and (looking-at "\\s<\\s<\\(\\s<\\)?") | |
| 459 (or (match-end 1) (/= (current-column) (current-indentation)))) | |
| 460 0 | |
| 461 (when (or (/= (current-column) (current-indentation)) | |
| 462 (and (> comment-add 0) (looking-at "\\s<\\S<"))) | |
| 463 comment-column))) | |
| 464 | |
| 465 ;;;###autoload | |
| 466 (defun comment-indent (&optional continue) | |
| 467 "Indent this line's comment to comment column, or insert an empty comment. | |
| 468 If CONTINUE is non-nil, use the `comment-continue' markers if any. | |
| 469 Comments starting in column 0 are not moved." | |
| 470 (interactive "*") | |
| 471 (comment-normalize-vars) | |
| 472 (let* ((empty (save-excursion (beginning-of-line) | |
| 473 (looking-at "[ \t]*$"))) | |
| 474 (starter (or (and continue comment-continue) | |
| 475 (and empty block-comment-start) comment-start)) | |
| 476 (ender (or (and continue comment-continue "") | |
| 477 (and empty block-comment-end) comment-end))) | |
| 478 (unless starter (error "No comment syntax defined")) | |
| 479 (beginning-of-line) | |
| 480 (let* ((eolpos (line-end-position)) | |
| 481 (begpos (comment-search-forward eolpos t)) | |
| 482 cpos indent) | |
| 483 ;; An existing comment? | |
| 2511 | 484 (if begpos |
| 485 (progn | |
| 486 (if (and (not (looking-at "[\t\n ]")) | |
| 487 (looking-at comment-end-skip)) | |
| 488 ;; The comment is empty and we have skipped all its space | |
| 489 ;; and landed right before the comment-ender: | |
| 490 ;; Go back to the middle of the space. | |
| 491 (forward-char (/ (skip-chars-backward " \t") -2))) | |
| 492 (setq cpos (point-marker))) | |
| 1333 | 493 ;; If none, insert one. |
| 494 (save-excursion | |
| 495 ;; Some comment-indent-function insist on not moving comments that | |
| 496 ;; are in column 0, so we first go to the likely target column. | |
| 497 (indent-to comment-column) | |
| 498 (setq begpos (point)) | |
| 2511 | 499 ;; Ensure there's a space before the comment for things |
| 500 ;; like sh where it matters (as well as being neater). | |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
501 ;; ... but unless we're at the beginning of a line -- dvl |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
502 (unless (or (bolp) (eq ?\ (char-syntax (char-before)))) |
| 2511 | 503 (insert ?\ )) |
| 1333 | 504 (insert starter) |
| 505 (setq cpos (point-marker)) | |
| 506 (insert ender))) | |
| 507 (goto-char begpos) | |
| 508 ;; Compute desired indent. | |
| 509 (setq indent (save-excursion (funcall comment-indent-function))) | |
| 510 (if (not indent) | |
| 2511 | 511 ;; comment-indent-function refuses: delegate to indent. |
| 1333 | 512 (indent-according-to-mode) |
| 513 ;; Avoid moving comments past the fill-column. | |
| 514 (unless (save-excursion (skip-chars-backward " \t") (bolp)) | |
| 515 (setq indent | |
| 516 (min indent | |
| 517 (+ (current-column) | |
| 2511 | 518 (- (or comment-fill-column fill-column) |
| 1333 | 519 (save-excursion (end-of-line) (current-column))))))) |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
520 ;; XEmacs change: Preserve indentation of comments starting in |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
521 ;; column 0, as documented. |
| 2511 | 522 (unless (or (= (current-column) 0) (= (current-column) indent)) |
| 1333 | 523 ;; If that's different from current, change it. |
| 2511 | 524 (delete-region (point) (progn (skip-chars-backward " \t") (point))) |
| 1333 | 525 (indent-to (if (bolp) indent |
| 526 (max indent (1+ (current-column))))))) | |
| 527 (goto-char cpos) | |
| 528 (set-marker cpos nil)))) | |
| 529 | |
| 530 ;;;###autoload | |
| 531 (defun comment-set-column (arg) | |
| 532 "Set the comment column based on point. | |
| 533 With no ARG, set the comment column to the current column. | |
| 534 With just minus as arg, kill any comment on this line. | |
| 535 With any other arg, set comment column to indentation of the previous comment | |
| 536 and then align or create a comment on this line at that column." | |
| 537 (interactive "P") | |
| 538 (cond | |
| 539 ((eq arg '-) (comment-kill nil)) | |
| 540 (arg | |
| 541 (save-excursion | |
| 542 (beginning-of-line) | |
| 543 (comment-search-backward) | |
| 544 (beginning-of-line) | |
| 545 (goto-char (comment-search-forward (line-end-position))) | |
| 546 (setq comment-column (current-column)) | |
| 547 (lmessage 'command "Comment column set to %d" comment-column)) | |
| 548 (comment-indent)) | |
| 549 (t (setq comment-column (current-column)) | |
| 550 (lmessage 'command "Comment column set to %d" comment-column)))) | |
| 551 | |
| 552 ;;;###autoload | |
| 553 (defun comment-kill (arg) | |
| 554 "Kill the comment on this line, if any. | |
| 555 With prefix ARG, kill comments on that many lines starting with this one." | |
| 556 ;; XEmacs change: add * | |
| 557 (interactive "*P") | |
| 558 (dotimes (_ (prefix-numeric-value arg)) | |
| 559 (save-excursion | |
| 560 (beginning-of-line) | |
| 561 (let ((cs (comment-search-forward (line-end-position) t))) | |
| 562 (when cs | |
| 563 (goto-char cs) | |
| 564 (skip-syntax-backward " ") | |
| 565 (setq cs (point)) | |
| 566 (comment-forward) | |
| 567 (kill-region cs (if (bolp) (1- (point)) (point))) | |
| 568 (indent-according-to-mode)))) | |
| 569 (if arg (forward-line 1)))) | |
| 570 | |
| 571 (defun comment-padright (str &optional n) | |
| 572 "Construct a string composed of STR plus `comment-padding'. | |
| 573 It also adds N copies of the last non-whitespace chars of STR. | |
| 574 If STR already contains padding, the corresponding amount is | |
| 575 ignored from `comment-padding'. | |
| 576 N defaults to 0. | |
| 577 If N is `re', a regexp is returned instead, that would match | |
| 578 the string for any N." | |
| 579 (setq n (or n 0)) | |
| 580 (when (and (stringp str) (not (string= "" str))) | |
| 581 ;; Separate the actual string from any leading/trailing padding | |
| 582 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str) | |
| 583 (let ((s (match-string 1 str)) ;actual string | |
| 584 (lpad (substring str 0 (match-beginning 1))) ;left padding | |
| 585 (rpad (concat (substring str (match-end 1)) ;original right padding | |
| 586 (substring comment-padding ;additional right padding | |
| 587 (min (- (match-end 0) (match-end 1)) | |
| 588 (length comment-padding))))) | |
| 589 ;; We can only duplicate C if the comment-end has multiple chars | |
| 590 ;; or if comments can be nested, else the comment-end `}' would | |
| 591 ;; be turned into `}}}' where only the first ends the comment | |
| 592 ;; and the rest becomes bogus junk. | |
| 593 (multi (not (and comment-quote-nested | |
| 594 ;; comment-end is a single char | |
| 595 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end))))) | |
| 596 (if (not (symbolp n)) | |
| 597 (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad) | |
| 598 ;; construct a regexp that would match anything from just S | |
| 599 ;; to any possible output of this function for any N. | |
| 600 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?")) | |
| 601 lpad "") ;padding is not required | |
| 602 (regexp-quote s) | |
| 603 (when multi "+") ;the last char of S might be repeated | |
| 604 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?")) | |
| 605 rpad "")))))) ;padding is not required | |
| 606 | |
| 607 (defun comment-padleft (str &optional n) | |
| 608 "Construct a string composed of `comment-padding' plus STR. | |
| 609 It also adds N copies of the first non-whitespace chars of STR. | |
| 610 If STR already contains padding, the corresponding amount is | |
| 611 ignored from `comment-padding'. | |
| 612 N defaults to 0. | |
| 613 If N is `re', a regexp is returned instead, that would match | |
| 614 the string for any N." | |
| 615 (setq n (or n 0)) | |
| 616 (when (and (stringp str) (not (string= "" str))) | |
| 617 ;; Only separate the left pad because we assume there is no right pad. | |
| 618 (string-match "\\`\\s-*" str) | |
| 619 (let ((s (substring str (match-end 0))) | |
| 620 (pad (concat (substring comment-padding | |
| 621 (min (- (match-end 0) (match-beginning 0)) | |
| 622 (length comment-padding))) | |
| 623 (match-string 0 str))) | |
| 624 (c (aref str (match-end 0))) ;the first non-space char of STR | |
| 625 ;; We can only duplicate C if the comment-end has multiple chars | |
| 626 ;; or if comments can be nested, else the comment-end `}' would | |
| 627 ;; be turned into `}}}' where only the first ends the comment | |
| 628 ;; and the rest becomes bogus junk. | |
| 629 (multi (not (and comment-quote-nested | |
| 630 ;; comment-end is a single char | |
| 631 (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end))))) | |
| 632 (if (not (symbolp n)) | |
| 633 (concat pad (when multi (make-string n c)) s) | |
| 634 ;; Construct a regexp that would match anything from just S | |
| 635 ;; to any possible output of this function for any N. | |
| 636 ;; We match any number of leading spaces because this regexp will | |
| 637 ;; be used for uncommenting where we might want to remove | |
| 638 ;; uncomment markers with arbitrary leading space (because | |
| 639 ;; they were aligned). | |
| 640 (concat "\\s-*" | |
| 641 (if multi (concat (regexp-quote (string c)) "*")) | |
| 642 (regexp-quote s)))))) | |
| 643 | |
| 644 ;;;###autoload | |
| 645 (defun uncomment-region (beg end &optional arg) | |
| 2511 | 646 "Uncomment each line in the BEG .. END region. |
| 1333 | 647 The numeric prefix ARG can specify a number of chars to remove from the |
| 648 comment markers." | |
| 649 (interactive "*r\nP") | |
| 650 (comment-normalize-vars) | |
| 651 (if (> beg end) (let (mid) (setq mid beg beg end end mid))) | |
| 652 (save-excursion | |
| 653 (goto-char beg) | |
| 654 (setq end (copy-marker end)) | |
| 655 | |
| 2511 | 656 (let* ((numarg (prefix-numeric-value arg)) |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
657 (ccs comment-continue) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
658 (srei (comment-padright ccs 're)) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
659 (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
660 spt) |
| 1333 | 661 (while (and (< (point) end) |
| 662 (setq spt (comment-search-forward end t))) | |
| 2511 | 663 (let ((ipt (point)) |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
664 ;; Find the end of the comment. |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
665 (ept (progn |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
666 (goto-char spt) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
667 (unless (comment-forward) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
668 (error "Can't find the comment end")) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
669 (point))) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
670 (box nil) |
|
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
671 (box-equal nil)) ;Whether we might be using `=' for boxes. |
| 1333 | 672 (save-restriction |
| 673 (narrow-to-region spt ept) | |
| 2511 | 674 |
| 1333 | 675 ;; Remove the comment-start. |
| 676 (goto-char ipt) | |
| 677 (skip-syntax-backward " ") | |
| 678 ;; A box-comment starts with a looong comment-start marker. | |
| 2511 | 679 (when (and (or (and (= (- (point) (point-min)) 1) |
| 680 (setq box-equal t) | |
| 681 (looking-at "=\\{7\\}") | |
| 682 (not (eq (char-before (point-max)) ?\n)) | |
| 683 (skip-chars-forward "=")) | |
| 684 (> (- (point) (point-min) (length comment-start)) 7)) | |
| 685 (> (count-lines (point-min) (point-max)) 2)) | |
| 1333 | 686 (setq box t)) |
| 687 (when (looking-at (regexp-quote comment-padding)) | |
| 688 (goto-char (match-end 0))) | |
| 689 (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei))) | |
| 690 (goto-char (match-end 0))) | |
| 691 (if (null arg) (delete-region (point-min) (point)) | |
| 692 (skip-syntax-backward " ") | |
| 693 (delete-char (- numarg))) | |
| 694 | |
| 695 ;; Remove the end-comment (and leading padding and such). | |
| 696 (goto-char (point-max)) (comment-enter-backward) | |
| 697 ;; Check for special `=' used sometimes in comment-box. | |
| 2511 | 698 (when (and box-equal (not (eq (char-before (point-max)) ?\n))) |
| 1333 | 699 (let ((pos (point))) |
| 700 ;; skip `=' but only if there are at least 7. | |
| 701 (when (> (skip-chars-backward "=") -7) (goto-char pos)))) | |
| 702 (unless (looking-at "\\(\n\\|\\s-\\)*\\'") | |
| 703 (when (and (bolp) (not (bobp))) (backward-char)) | |
| 704 (if (null arg) (delete-region (point) (point-max)) | |
| 705 (skip-syntax-forward " ") | |
| 706 (delete-char numarg))) | |
| 707 | |
| 708 ;; Unquote any nested end-comment. | |
| 709 (comment-quote-nested comment-start comment-end t) | |
| 710 | |
| 711 ;; Eliminate continuation markers as well. | |
| 712 (when sre | |
| 713 (let* ((cce (comment-string-reverse (or comment-continue | |
| 714 comment-start))) | |
| 715 (erei (and box (comment-padleft cce 're))) | |
| 716 (ere (and erei (concat "\\(" erei "\\)\\s-*$")))) | |
| 717 (goto-char (point-min)) | |
| 718 (while (progn | |
| 719 (if (and ere (re-search-forward | |
| 720 ere (line-end-position) t)) | |
| 721 (replace-match "" t t nil (if (match-end 2) 2 1)) | |
| 722 (setq ere nil)) | |
| 723 (forward-line 1) | |
| 724 (re-search-forward sre (line-end-position) t)) | |
| 725 (replace-match "" t t nil (if (match-end 2) 2 1))))) | |
| 2116 | 726 ;; Go to the end for the next comment. |
| 1333 | 727 (goto-char (point-max))))) |
| 728 (set-marker end nil)))) | |
| 729 | |
| 730 (defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block) | |
| 731 "Make the leading and trailing extra lines. | |
| 732 This is used for `extra-line' style (or `box' style if BLOCK is specified)." | |
| 733 (let ((eindent 0)) | |
| 734 (if (not block) | |
| 735 ;; Try to match CS and CE's content so they align aesthetically. | |
| 736 (progn | |
| 737 (setq ce (comment-string-strip ce t t)) | |
| 738 (when (string-match "\\(.+\\).*\n\\(.*?\\)\\1" (concat ce "\n" cs)) | |
| 739 (setq eindent | |
| 740 (max (- (match-end 2) (match-beginning 2) (match-beginning 0)) | |
| 741 0)))) | |
| 742 ;; box comment | |
| 743 (let* ((width (- max-indent min-indent)) | |
| 744 (s (concat cs "a=m" cce)) | |
| 745 (e (concat ccs "a=m" ce)) | |
| 746 (c (if (string-match ".*\\S-\\S-" cs) | |
| 2511 | 747 (aref cs (1- (match-end 0))) |
| 748 (if (and (equal comment-end "") (string-match ".*\\S-" cs)) | |
| 749 (aref cs (1- (match-end 0))) ?=))) | |
| 750 (re "\\s-*a=m\\s-*") | |
| 751 ; Huh? (_ (string-match re s)) | |
| 752 (lcs (length cs)) | |
| 1333 | 753 (fill |
| 754 (make-string (+ width (- (match-end 0) | |
| 2511 | 755 (match-beginning 0) lcs 3)) c))) |
| 1333 | 756 (setq cs (replace-match fill t t s)) |
| 2511 | 757 (when (and (not (string-match comment-start-skip cs)) |
| 758 (string-match "a=m" s)) | |
| 759 ;; The whitespace around CS cannot be ignored: put it back. | |
| 760 (setq re "a=m") | |
| 761 (setq fill (make-string (- width lcs) c)) | |
| 762 (setq cs (replace-match fill t t s))) | |
| 763 (string-match re e) | |
| 1333 | 764 (setq ce (replace-match fill t t e)))) |
| 765 (cons (concat cs "\n" (make-string min-indent ? ) ccs) | |
| 766 (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce)))) | |
| 767 | |
| 768 (defmacro comment-with-narrowing (beg end &rest body) | |
| 769 "Execute BODY with BEG..END narrowing. | |
| 770 Space is added (and then removed) at the beginning for the text's | |
| 771 indentation to be kept as it was before narrowing." | |
| 2511 | 772 (declare (debug t) (indent 2)) |
| 1333 | 773 (let ((bindent (make-symbol "bindent"))) |
| 774 `(let ((,bindent (save-excursion (goto-char beg) (current-column)))) | |
| 775 (save-restriction | |
| 776 (narrow-to-region beg end) | |
| 777 (goto-char (point-min)) | |
| 778 (insert (make-string ,bindent ? )) | |
| 779 (prog1 | |
| 780 (progn ,@body) | |
| 781 ;; remove the bindent | |
| 782 (save-excursion | |
| 783 (goto-char (point-min)) | |
| 784 (when (looking-at " *") | |
| 785 (let ((n (min (- (match-end 0) (match-beginning 0)) ,bindent))) | |
| 786 (delete-char n) | |
| 787 (setq ,bindent (- ,bindent n)))) | |
| 788 (end-of-line) | |
| 789 (let ((e (point))) | |
| 790 (beginning-of-line) | |
| 791 (while (and (> ,bindent 0) (re-search-forward " *" e t)) | |
| 792 (let ((n (min ,bindent (- (match-end 0) (match-beginning 0) 1)))) | |
| 793 (goto-char (match-beginning 0)) | |
| 794 (delete-char n) | |
| 795 (setq ,bindent (- ,bindent n))))))))))) | |
| 796 | |
| 797 (defun comment-region-internal (beg end cs ce | |
| 798 &optional ccs cce block lines indent) | |
| 2511 | 799 "Comment region BEG .. END. |
| 1333 | 800 CS and CE are the comment start resp end string. |
| 801 CCS and CCE are the comment continuation strings for the start resp end | |
| 802 of lines (default to CS and CE). | |
| 803 BLOCK indicates that end of lines should be marked with either CCE, CE or CS | |
| 804 \(if CE is empty) and that those markers should be aligned. | |
| 805 LINES indicates that an extra lines will be used at the beginning and end | |
| 806 of the region for CE and CS. | |
| 807 INDENT indicates to put CS and CCS at the current indentation of the region | |
| 808 rather than at left margin." | |
| 809 ;;(assert (< beg end)) | |
| 810 (let ((no-empty t)) | |
| 811 ;; Sanitize CE and CCE. | |
| 812 (if (and (stringp ce) (string= "" ce)) (setq ce nil)) | |
| 813 (if (and (stringp cce) (string= "" cce)) (setq cce nil)) | |
| 814 ;; If CE is empty, multiline cannot be used. | |
| 815 (unless ce (setq ccs nil cce nil)) | |
| 816 ;; Should we mark empty lines as well ? | |
| 817 (if (or ccs block lines) (setq no-empty nil)) | |
| 818 ;; Make sure we have end-markers for BLOCK mode. | |
| 819 (when block (unless ce (setq ce (comment-string-reverse cs)))) | |
| 820 ;; If BLOCK is not requested, we don't need CCE. | |
| 821 (unless block (setq cce nil)) | |
| 822 ;; Continuation defaults to the same as CS and CE. | |
| 823 (unless ccs (setq ccs cs cce ce)) | |
| 2511 | 824 |
| 1333 | 825 (save-excursion |
| 826 (goto-char end) | |
| 827 ;; If the end is not at the end of a line and the comment-end | |
| 828 ;; is implicit (i.e. a newline), explicitly insert a newline. | |
| 829 (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode)) | |
| 830 (comment-with-narrowing beg end | |
| 831 (let ((min-indent (point-max)) | |
| 832 (max-indent 0)) | |
| 833 (goto-char (point-min)) | |
| 834 ;; Quote any nested comment marker | |
| 835 (comment-quote-nested comment-start comment-end nil) | |
| 836 | |
| 837 ;; Loop over all lines to find the needed indentations. | |
| 838 (goto-char (point-min)) | |
| 839 (while | |
| 840 (progn | |
| 841 (unless (looking-at "[ \t]*$") | |
| 842 (setq min-indent (min min-indent (current-indentation)))) | |
| 843 (end-of-line) | |
| 844 (setq max-indent (max max-indent (current-column))) | |
| 845 (not (or (eobp) (progn (forward-line) nil))))) | |
| 2511 | 846 |
| 1333 | 847 ;; Inserting ccs can change max-indent by (1- tab-width). |
| 848 (setq max-indent | |
| 849 (+ max-indent (max (length cs) (length ccs)) tab-width -1)) | |
| 850 (unless indent (setq min-indent 0)) | |
| 851 | |
| 852 ;; make the leading and trailing lines if requested | |
| 853 (when lines | |
| 854 (let ((csce | |
| 855 (comment-make-extra-lines | |
| 856 cs ce ccs cce min-indent max-indent block))) | |
| 857 (setq cs (car csce)) | |
| 858 (setq ce (cdr csce)))) | |
| 2511 | 859 |
| 1333 | 860 (goto-char (point-min)) |
| 861 ;; Loop over all lines from BEG to END. | |
| 862 (while | |
| 863 (progn | |
| 864 (unless (and no-empty (looking-at "[ \t]*$")) | |
| 865 (move-to-column min-indent t) | |
| 866 (insert cs) (setq cs ccs) ;switch to CCS after the first line | |
| 867 (end-of-line) | |
| 868 (if (eobp) (setq cce ce)) | |
| 869 (when cce | |
| 870 (when block (move-to-column max-indent t)) | |
| 871 (insert cce))) | |
| 872 (end-of-line) | |
| 873 (not (or (eobp) (progn (forward-line) nil)))))))))) | |
| 874 | |
| 875 ;;;###autoload | |
| 876 (defun comment-region (beg end &optional arg) | |
| 877 "Comment or uncomment each line in the region. | |
| 2511 | 878 With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END. |
| 1333 | 879 Numeric prefix arg ARG means use ARG comment characters. |
| 880 If ARG is negative, delete that many comment characters instead. | |
| 881 By default, comments start at the left margin, are terminated on each line, | |
| 882 even for syntax in which newline does not end the comment and blank lines | |
| 883 do not get comments. This can be changed with `comment-style'. | |
| 884 | |
| 885 The strings used as comment starts are built from | |
| 886 `comment-start' without trailing spaces and `comment-padding'." | |
| 887 (interactive "*r\nP") | |
| 888 (comment-normalize-vars) | |
| 889 (if (> beg end) (let (mid) (setq mid beg beg end end mid))) | |
| 890 (let* ((numarg (prefix-numeric-value arg)) | |
| 891 (add comment-add) | |
| 892 (style (cdr (assoc comment-style comment-styles))) | |
| 893 (lines (nth 2 style)) | |
| 894 (block (nth 1 style)) | |
| 895 (multi (nth 0 style))) | |
| 896 (save-excursion | |
| 897 ;; we use `chars' instead of `syntax' because `\n' might be | |
| 898 ;; of end-comment syntax rather than of whitespace syntax. | |
| 899 ;; sanitize BEG and END | |
| 900 (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) | |
| 901 (setq beg (max beg (point))) | |
| 902 (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) | |
| 903 (setq end (min end (point))) | |
| 904 (if (>= beg end) (error "Nothing to comment")) | |
| 905 | |
| 906 ;; sanitize LINES | |
| 907 (setq lines | |
| 908 (and | |
| 909 lines ;; multi | |
| 910 (progn (goto-char beg) (beginning-of-line) | |
| 911 (skip-syntax-forward " ") | |
| 912 (>= (point) beg)) | |
| 913 (progn (goto-char end) (end-of-line) (skip-syntax-backward " ") | |
| 914 (<= (point) end)) | |
| 2511 | 915 (or block (not (string= "" comment-end))) |
| 916 (or block (progn (goto-char beg) (search-forward "\n" end t)))))) | |
| 1333 | 917 |
| 918 ;; don't add end-markers just because the user asked for `block' | |
| 919 (unless (or lines (string= "" comment-end)) (setq block nil)) | |
| 920 | |
| 921 (cond | |
| 922 ((consp arg) (uncomment-region beg end)) | |
| 923 ((< numarg 0) (uncomment-region beg end (- numarg))) | |
| 924 (t | |
| 925 (setq numarg (if (and (null arg) (= (length comment-start) 1)) | |
| 926 add (1- numarg))) | |
| 927 (comment-region-internal | |
| 928 beg end | |
| 929 (let ((s (comment-padright comment-start numarg))) | |
| 930 (if (string-match comment-start-skip s) s | |
| 931 (comment-padright comment-start))) | |
| 932 (let ((s (comment-padleft comment-end numarg))) | |
| 933 (and s (if (string-match comment-end-skip s) s | |
| 934 (comment-padright comment-end)))) | |
| 935 (if multi (comment-padright comment-continue numarg)) | |
| 936 (if multi (comment-padleft (comment-string-reverse comment-continue) numarg)) | |
| 937 block | |
| 938 lines | |
| 939 (nth 3 style)))))) | |
| 940 | |
| 941 (defun comment-box (beg end &optional arg) | |
| 2511 | 942 "Comment out the BEG .. END region, putting it inside a box. |
| 1333 | 943 The numeric prefix ARG specifies how many characters to add to begin- and |
| 944 end- comment markers additionally to what `comment-add' already specifies." | |
| 945 (interactive "*r\np") | |
| 946 (let ((comment-style (if (cadr (assoc comment-style comment-styles)) | |
| 947 'box-multi 'box))) | |
| 948 (comment-region beg end (+ comment-add arg)))) | |
| 949 | |
| 2511 | 950 |
| 951 ;;;###autoload | |
| 952 (defun comment-or-uncomment-region (beg end &optional arg) | |
| 953 "Call `comment-region', unless the region only consists of comments, | |
| 954 in which case call `uncomment-region'. If a prefix arg is given, it | |
| 955 is passed on to the respective function." | |
| 956 (interactive "*r\nP") | |
| 957 (funcall (if (save-excursion ;; check for already commented region | |
| 958 (goto-char beg) | |
| 959 (comment-forward (point-max)) | |
| 960 (<= end (point))) | |
| 961 'uncomment-region 'comment-region) | |
| 962 beg end arg)) | |
| 963 | |
| 1333 | 964 ;;;###autoload |
| 965 (defun comment-dwim (arg) | |
| 966 "Call the comment command you want (Do What I Mean). | |
| 967 If the region is active and `transient-mark-mode' is on, call | |
| 968 `comment-region' (unless it only consists of comments, in which | |
| 969 case it calls `uncomment-region'). | |
| 970 Else, if the current line is empty, insert a comment and indent it. | |
| 971 Else if a prefix ARG is specified, call `comment-kill'. | |
| 972 Else, call `comment-indent'." | |
| 973 (interactive "*P") | |
| 974 (comment-normalize-vars) | |
| 975 (if (region-active-p) ;mark-active transient-mark-mode) | |
| 2511 | 976 (comment-or-uncomment-region (region-beginning) (region-end) arg) |
| 1333 | 977 (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$"))) |
| 978 ;; FIXME: If there's no comment to kill on this line and ARG is | |
| 979 ;; specified, calling comment-kill is not very clever. | |
| 980 (if arg (comment-kill (and (integerp arg) arg)) (comment-indent)) | |
| 981 (let ((add (if arg (prefix-numeric-value arg) | |
| 982 (if (= (length comment-start) 1) comment-add 0)))) | |
| 983 ;; Some modes insist on keeping column 0 comment in column 0 | |
| 984 ;; so we need to move away from it before inserting the comment. | |
| 985 (indent-according-to-mode) | |
| 986 (insert (comment-padright comment-start add)) | |
| 987 (save-excursion | |
| 988 (unless (string= "" comment-end) | |
| 989 (insert (comment-padleft comment-end add))) | |
| 990 (indent-according-to-mode)))))) | |
| 991 | |
| 992 (defcustom comment-auto-fill-only-comments nil | |
| 993 "Non-nil means to only auto-fill inside comments. | |
| 994 This has no effect in modes that do not define a comment syntax." | |
| 2511 | 995 :type 'boolean) |
| 996 | |
| 997 (defun comment-valid-prefix (prefix compos) | |
| 998 (or | |
| 999 ;; Accept any prefix if the current comment is not EOL-terminated. | |
| 1000 (save-excursion (goto-char compos) (comment-forward) (not (bolp))) | |
| 1001 ;; Accept any prefix that starts with a comment-start marker. | |
| 1002 (string-match (concat "\\`[ \t]*\\(?:" comment-start-skip "\\)") | |
| 1003 fill-prefix))) | |
| 1333 | 1004 |
| 1005 ;;;###autoload | |
| 1006 (defun comment-indent-new-line (&optional soft) | |
| 1007 "Break line at point and indent, continuing comment if within one. | |
| 1008 This indents the body of the continued comment | |
| 1009 under the previous comment line. | |
| 1010 | |
| 1011 This command is intended for styles where you write a comment per line, | |
| 1012 starting a new comment (and terminating it if necessary) on each line. | |
| 1013 If you want to continue one comment across several lines, use \\[newline-and-indent]. | |
| 1014 | |
| 1015 If a fill column is specified, it overrides the use of the comment column | |
| 1016 or comment indentation. | |
| 1017 | |
| 1018 The inserted newline is marked hard if variable `use-hard-newlines' is true, | |
| 1019 unless optional argument SOFT is non-nil." | |
| 1020 (interactive) | |
| 1021 (comment-normalize-vars t) | |
| 1022 (let (compos comin) | |
| 1023 ;; If we are not inside a comment and we only auto-fill comments, | |
| 1024 ;; don't do anything (unless no comment syntax is defined). | |
| 1025 (unless (and comment-start | |
| 1026 comment-auto-fill-only-comments | |
| 2511 | 1027 (not (interactive-p)) |
| 1333 | 1028 (not (save-excursion |
| 1029 (prog1 (setq compos (comment-beginning)) | |
| 1030 (setq comin (point)))))) | |
| 1031 | |
| 1032 ;; XEmacs: next 3 lines from old version. | |
| 1033 (skip-chars-backward " \t") | |
| 1034 (if (featurep 'mule) | |
| 1035 (declare-fboundp (kinsoku-process))) | |
| 2511 | 1036 |
| 1037 ;; Now we know we should auto-fill. | |
| 1038 ;; Insert the newline before removing empty space so that markers | |
| 1039 ;; get preserved better. | |
| 1333 | 1040 (if soft (insert-and-inherit ?\n) (newline 1)) |
| 2511 | 1041 (save-excursion (forward-char -1) (delete-horizontal-space)) |
| 1042 (delete-horizontal-space) | |
| 1043 | |
| 1044 (if (and fill-prefix (not adaptive-fill-mode)) | |
| 1045 ;; Blindly trust a non-adaptive fill-prefix. | |
| 1333 | 1046 (progn |
| 1047 (indent-to-left-margin) | |
| 2511 | 1048 (insert-before-markers-and-inherit fill-prefix)) |
| 1333 | 1049 |
| 1050 ;;#### jhod: probably need to fix this for kinsoku processing | |
| 1051 ;; If necessary check whether we're inside a comment. | |
| 2511 | 1052 (unless (or compos (null comment-start)) |
| 1333 | 1053 (save-excursion |
| 1054 (backward-char) | |
| 1055 (setq compos (comment-beginning)) | |
| 1056 (setq comin (point)))) | |
| 1057 | |
| 2511 | 1058 (cond |
| 1059 ;; If there's an adaptive prefix, use it unless we're inside | |
| 1060 ;; a comment and the prefix is not a comment starter. | |
| 1061 ((and fill-prefix | |
| 1062 (or (not compos) | |
| 1063 (comment-valid-prefix fill-prefix compos))) | |
| 1064 (indent-to-left-margin) | |
| 1065 (insert-and-inherit fill-prefix)) | |
| 1066 ;; If we're not inside a comment, just try to indent. | |
| 1067 ;; #### XEmacs: the line `(if comcol' was changed as follows. | |
| 1068 ;; I'm leaving it out since who knows if it's applicable any more. | |
| 1069 ;; --ben | |
| 1070 ;; (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras. | |
| 1071 ((not compos) (indent-according-to-mode)) | |
| 1072 (t | |
| 1333 | 1073 (let* ((comment-column |
| 1074 ;; The continuation indentation should be somewhere between | |
| 1075 ;; the current line's indentation (plus 2 for good measure) | |
| 1076 ;; and the current comment's indentation, with a preference | |
| 1077 ;; for comment-column. | |
| 1078 (save-excursion | |
| 2511 | 1079 ;; FIXME: use prev line's info rather than first line's. |
| 1333 | 1080 (goto-char compos) |
| 1081 (min (current-column) (max comment-column | |
| 1082 (+ 2 (current-indentation)))))) | |
| 1083 (comstart (buffer-substring compos comin)) | |
| 1084 (normalp | |
| 1085 (string-match (regexp-quote (comment-string-strip | |
| 1086 comment-start t t)) | |
| 1087 comstart)) | |
| 1088 (comment-end | |
| 1089 (if normalp comment-end | |
| 1090 ;; The comment starter is not the normal comment-start | |
| 1091 ;; so we can't just use comment-end. | |
| 1092 (save-excursion | |
| 1093 (goto-char compos) | |
| 1094 (if (not (comment-forward)) comment-end | |
| 1095 (comment-string-strip | |
| 1096 (buffer-substring | |
| 1097 (save-excursion (comment-enter-backward) (point)) | |
| 1098 (point)) | |
| 1099 nil t))))) | |
| 1100 (comment-start comstart) | |
|
4435
1e2fc51563a5
Fix auto-formatting of comments in auto-fill-mode
Didier Verna <didier@xemacs.org>
parents:
3289
diff
changeset
|
1101 (block-comment-start comment-start) |
| 2511 | 1102 (continuep (or comment-multi-line |
| 1103 (cadr (assoc comment-style comment-styles)))) | |
| 1333 | 1104 ;; Force comment-continue to be recreated from comment-start. |
| 1105 ;; FIXME: wrong if comment-continue was set explicitly! | |
| 2511 | 1106 ;; FIXME: use prev line's continuation if available. |
| 1333 | 1107 (comment-continue nil)) |
| 2511 | 1108 (if (and comment-multi-line (> (length comment-end) 0)) |
| 1109 (indent-according-to-mode) | |
| 1110 (insert-and-inherit ?\n) | |
| 1111 (forward-char -1) | |
| 1112 (comment-indent continuep) | |
| 1113 (save-excursion | |
| 1114 (let ((pt (point))) | |
| 1115 (end-of-line) | |
| 1116 (let ((comend (buffer-substring pt (point)))) | |
| 1117 ;; The 1+ is to make sure we delete the \n inserted above. | |
| 1118 (delete-region pt (1+ (point))) | |
| 1119 (end-of-line 0) | |
| 1120 (insert comend)))))))))))) | |
| 1333 | 1121 |
| 1122 (provide 'newcomment) | |
| 1123 | |
| 1124 ;;; newcomment.el ends here |