diff lisp/newcomment.el @ 1333:1b0339b048ce

[xemacs-hg @ 2003-03-02 09:38:37 by ben] To: xemacs-patches@xemacs.org PROBLEMS: Include nt/PROBLEMS and update. Add note about incremental linking badness. cmdloop.el, custom.el, dumped-lisp.el, files.el, keydefs.el, keymap.el, lisp-mode.el, make-docfile.el, replace.el, simple.el, subr.el, view-less.el, wid-edit.el: Lots of syncing with FSF 21.2. Use if-fboundp in wid-edit.el. New file newcomment.el from FSF. internals/internals.texi: Fix typo. (Build-Time Dependencies): New node. PROBLEMS: Delete. config.inc.samp, xemacs.mak: Eliminate HAVE_VC6, use SUPPORT_EDIT_AND_CONTINUE in its place. No incremental linking unless SUPPORT_EDIT_AND_CONTINUE, since it can cause nasty crashes in pdump. Put warnings about this in config.inc.samp. Report the full compile flags used for src and lib-src in the Installation output. alloc.c, lisp.h, ralloc.c, regex.c: Use ALLOCA() in regex.c to avoid excessive stack allocation. Also fix subtle problem with REL_ALLOC() -- any call to malloc() (direct or indirect) may relocate rel-alloced data, causing buffer text to shift. After any such call, regex must update all its pointers to such data. Add a system, when ERROR_CHECK_MALLOC, whereby regex.c indicates all the places it is prepared to handle malloc()/realloc()/free(), and any calls anywhere in XEmacs outside of this will trigger an abort. alloc.c, dialog-msw.c, eval.c, event-stream.c, general-slots.h, insdel.c, lisp.h, menubar-msw.c, menubar-x.c: Change *run_hook*_trapping_problems to take a warning class, not a string. Factor out code to issue warnings, add flag to call_trapping_problems() to postpone warning issue, and make *run_hook*_trapping_problems issue their own warnings tailored to the hook, postponed in the case of safe_run_hook_trapping_problems() so that the appropriate message can be issued about resetting to nil only when not `quit'. Make record_unwind_protect_restoring_int() non-static. dumper.c: Issue notes about incremental linking problems under Windows. fileio.c: Mule-ize encrypt/decrypt-string code. text.h: Spacing changes.
author ben
date Sun, 02 Mar 2003 09:38:54 +0000
parents
children ce294639d321
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/newcomment.el	Sun Mar 02 09:38:54 2003 +0000
@@ -0,0 +1,1071 @@
+;;; newcomment.el --- (un)comment regions of buffers
+
+;; Copyright (C) 1999, 2000  Free Software Foundation Inc.
+
+;; Author: code extracted from Emacs-20's simple.el
+;; Maintainer: Stefan Monnier <monnier@cs.yale.edu>
+;; Keywords: comment uncomment
+;; Revision: $Id: newcomment.el,v 1.1 2003/03/02 09:38:40 ben Exp $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; A replacement for simple.el's comment-related functions.
+
+;;; Bugs:
+
+;; - single-char nestable comment-start can only do the "\\s<+" stuff
+;;   if the corresponding closing marker happens to be right.
+;; - comment-box in TeXinfo generate bogus comments @ccccc@
+;; - uncomment-region with a numeric argument can render multichar
+;;   comment markers invalid.
+;; - comment-indent or comment-region when called inside a comment
+;;   will happily break the surrounding comment.
+;; - comment-quote-nested will not (un)quote properly all nested comment
+;;   markers if there are more than just comment-start and comment-end.
+;;   For example, in Pascal where {...*) and (*...} are possible.
+
+;;; Todo:
+
+;; - quantized steps in comment-alignment
+;; - try to align tail comments
+;; - check what c-comment-line-break-function has to say
+;; - spill auto-fill of comments onto the end of the next line
+;; - uncomment-region with a consp (for blocks) or somehow make the
+;;   deletion of continuation markers less dangerous
+;; - drop block-comment-<foo> unless it's really used
+;; - uncomment-region on a subpart of a comment
+;; - support gnu-style "multi-line with space in continue"
+;; - somehow allow comment-dwim to use the region even if transient-mark-mode
+;;   is not turned on.
+
+;; - when auto-filling a comment, try to move the comment to the left
+;;   rather than break it (if possible).
+;; - sometimes default the comment-column to the same
+;;   one used on the preceding line(s).
+
+;;; Code:
+
+;;;###autoload
+(defalias 'indent-for-comment 'comment-indent)
+;;;###autoload
+(defalias 'set-comment-column 'comment-set-column)
+;;;###autoload
+(defalias 'kill-comment 'comment-kill)
+;;;###autoload
+(defalias 'indent-new-comment-line 'comment-indent-new-line)
+
+;;;###autoload
+(defgroup comment nil
+  "Indenting and filling of comments."
+  :prefix "comment-"
+  :version "21.1"
+  :group 'fill)
+
+(defvar comment-use-syntax 'undecided
+  "Non-nil if syntax-tables can be used instead of regexps.
+Can also be `undecided' which means that a somewhat expensive test will
+be used to try to determine whether syntax-tables should be trusted
+to understand comments or not in the given buffer.
+Major modes should set this variable.")
+
+;;;###autoload
+(defcustom comment-column 32
+  "*Column to indent right-margin comments to.
+Setting this variable automatically makes it local to the current buffer.
+Each mode establishes a different default value for this variable; you
+can set the value for a particular mode using that mode's hook."
+  :type 'integer
+  :group 'comment)
+(make-variable-buffer-local 'comment-column)
+
+;;;###autoload
+(defvar comment-start nil
+  "*String to insert to start a new comment, or nil if no comment syntax.")
+
+;;;###autoload
+(defvar comment-start-skip nil
+  "*Regexp to match the start of a comment plus everything up to its body.
+If there are any \\(...\\) pairs, the comment delimiter text is held to begin
+at the place matched by the close of the first pair.")
+
+;;;###autoload
+(defvar comment-end-skip nil
+  "Regexp to match the end of a comment plus everything up to its body.")
+
+;;;###autoload
+(defvar comment-end ""
+  "*String to insert to end a new comment.
+Should be an empty string if comments are terminated by end-of-line.")
+
+;;;###autoload
+(defvar comment-indent-function 'comment-indent-default
+  "Function to compute desired indentation for a comment.
+This function is called with no args with point at the beginning of
+the comment's starting delimiter and should return either the desired
+column indentation or nil.
+If nil is returned, indentation is delegated to `indent-according-to-mode'.")
+
+(defvar block-comment-start nil)
+(defvar block-comment-end nil)
+
+(defvar comment-quote-nested t
+  "Non-nil if nested comments should be quoted.
+This should be locally set by each major mode if needed.")
+
+(defvar comment-continue nil
+  "Continuation string to insert for multiline comments.
+This string will be added at the beginning of each line except the very
+first one when commenting a region with a commenting style that allows
+comments to span several lines.
+It should generally have the same length as `comment-start' in order to
+preserve indentation.
+If it is nil a value will be automatically derived from `comment-start'
+by replacing its first character with a space.")
+
+(defvar comment-add 0
+  "How many more comment chars should be inserted by `comment-region'.
+This determines the default value of the numeric argument of `comment-region'.
+This should generally stay 0, except for a few modes like Lisp where
+it can be convenient to set it to 1 so that regions are commented with
+two semi-colons.")
+
+(defconst comment-styles
+  '((plain	. (nil nil nil nil))
+    (indent	. (nil nil nil t))
+    (aligned	. (nil t nil t))
+    (multi-line	. (t nil nil t))
+    (extra-line	. (t nil t t))
+    (box	. (nil t t t))
+    (box-multi	. (t t t t)))
+  "Possible comment styles of the form (STYLE . (MULTI ALIGN EXTRA INDENT)).
+STYLE should be a mnemonic symbol.
+MULTI specifies that comments are allowed to span multiple lines.
+ALIGN specifies that the `comment-end' markers should be aligned.
+EXTRA specifies that an extra line should be used before and after the
+  region to comment (to put the `comment-end' and `comment-start').
+INDENT specifies that the `comment-start' markers should not be put at the
+  left margin but at the current indentation of the region to comment.")
+
+;;;###autoload
+(defcustom comment-style 'plain
+  "*Style to be used for `comment-region'.
+See `comment-styles' for a list of available styles."
+  :group 'comment
+  :type (if (boundp 'comment-styles)
+	    `(choice ,@(mapcar (lambda (s) `(const ,(car s))) comment-styles))
+	  'symbol))
+
+;;;###autoload
+(defcustom comment-padding " "
+  "Padding string that `comment-region' puts between comment chars and text.
+Can also be an integer which will be automatically turned into a string
+of the corresponding number of spaces.
+
+Extra spacing between the comment characters and the comment text
+makes the comment easier to read.  Default is \" \".  nil means 0."
+  :group 'comment
+  :type '(choice string integer (const nil)))
+
+;;;###autoload
+(defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill
+  "*Non-nil means \\[indent-new-comment-line] should continue same comment
+on new line, with no new terminator or starter.
+This is obsolete because you might as well use \\[newline-and-indent]."
+  :type 'boolean
+  :group 'comment)
+
+;;;;
+;;;; Helpers
+;;;;
+
+(defun comment-string-strip (str beforep afterp)
+  "Strip STR of any leading (if BEFOREP) and/or trailing (if AFTERP) space."
+  (string-match (concat "\\`" (if beforep "\\s-*")
+			"\\(.*?\\)" (if afterp "\\s-*\n?")
+			"\\'") str)
+  (match-string 1 str))
+
+(defun comment-string-reverse (s)
+  "Return the mirror image of string S, without any trailing space."
+  (comment-string-strip (concat (nreverse (string-to-list s))) nil t))
+
+(defun comment-normalize-vars (&optional noerror)
+  (if (not comment-start) (or noerror (error "No comment syntax is defined"))
+    ;; comment-use-syntax
+    (when (eq comment-use-syntax 'undecided)
+      (set (make-local-variable 'comment-use-syntax)
+	   (let ((st (syntax-table))
+		 (cs comment-start)
+		 (ce (if (string= "" comment-end) "\n" comment-end)))
+	     ;; Try to skip over a comment using forward-comment
+	     ;; to see if the syntax tables properly recognize it.
+	     (with-temp-buffer
+	       (set-syntax-table st)
+	       (insert cs " hello " ce)
+	       (goto-char (point-min))
+	       (and (forward-comment 1) (eobp))))))
+    ;; comment-padding
+    (unless comment-padding (setq comment-padding 0))
+    (when (integerp comment-padding)
+      (setq comment-padding (make-string comment-padding ? )))
+    ;; comment markers
+    ;;(setq comment-start (comment-string-strip comment-start t nil))
+    ;;(setq comment-end (comment-string-strip comment-end nil t))
+    ;; comment-continue
+    (unless (or comment-continue (string= comment-end ""))
+      (set (make-local-variable 'comment-continue)
+	   (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
+		   (substring comment-start 1))))
+    ;; comment-skip regexps
+    (unless comment-start-skip
+      (set (make-local-variable 'comment-start-skip)
+	   (concat "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
+		   (regexp-quote (comment-string-strip comment-start t t))
+		   ;; Let's not allow any \s- but only [ \t] since \n
+		   ;; might be both a comment-end marker and \s-.
+		   "+\\)[ \t]*")))
+    (unless comment-end-skip
+      (let ((ce (if (string= "" comment-end) "\n"
+		  (comment-string-strip comment-end t t))))
+	(set (make-local-variable 'comment-end-skip)
+	     ;; We use [ \t] rather than \s- because we don't want to
+	     ;; remove ^L in C mode when uncommenting.
+	     (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
+		     "\\|" (regexp-quote (substring ce 0 1))
+		     (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
+		     (regexp-quote (substring ce 1))
+		     "\\)"))))))
+ 
+(defun comment-quote-re (str unp)
+  (concat (regexp-quote (substring str 0 1))
+	  "\\\\" (if unp "+" "*")
+	  (regexp-quote (substring str 1))))
+
+(defun comment-quote-nested (cs ce unp)
+  "Quote or unquote nested comments.
+If UNP is non-nil, unquote nested comment markers."
+  (setq cs (comment-string-strip cs t t))
+  (setq ce (comment-string-strip ce t t))
+  (when (and comment-quote-nested (> (length ce) 0))
+    (let ((re (concat (comment-quote-re ce unp)
+		      "\\|" (comment-quote-re cs unp))))
+      (goto-char (point-min))
+      (while (re-search-forward re nil t)
+	(goto-char (match-beginning 0))
+	(forward-char 1)
+	(if unp (delete-char 1) (insert "\\"))
+	(when (= (length ce) 1)
+	  ;; If the comment-end is a single char, adding a \ after that
+	  ;; "first" char won't deactivate it, so we turn such a CE
+	  ;; into !CS.  I.e. for pascal, we turn } into !{
+	  (if (not unp)
+	      (when (string= (match-string 0) ce)
+		(replace-match (concat "!" cs) t t))
+	    (when (and (< (point-min) (match-beginning 0))
+		       (string= (buffer-substring (1- (match-beginning 0))
+						  (1- (match-end 0)))
+				(concat "!" cs)))
+	      (backward-char 2)
+	      (delete-char (- (match-end 0) (match-beginning 0)))
+	      (insert ce))))))))
+
+;;;;
+;;;; Navigation
+;;;;
+
+(defun comment-search-forward (limit &optional noerror)
+  "Find a comment start between point and LIMIT.
+Moves point to inside the comment and returns the position of the
+comment-starter.  If no comment is found, moves point to LIMIT
+and raises an error or returns nil of NOERROR is non-nil."
+  (if (not comment-use-syntax)
+      (if (re-search-forward comment-start-skip limit noerror)
+	  (or (match-end 1) (match-beginning 0))
+	(goto-char limit)
+	(unless noerror (error "No comment")))
+    (let* ((pt (point))
+	   ;; Assume (at first) that pt is outside of any string.
+	   (s (parse-partial-sexp pt (or limit (point-max)) nil nil nil t)))
+      (when (and (nth 8 s) (nth 3 s))
+	  ;; The search ended inside a string.  Try to see if it
+	  ;; works better when we assume that pt is inside a string.
+	  (setq s (parse-partial-sexp
+		   pt (or limit (point-max)) nil nil
+		   (list nil nil nil (nth 3 s) nil nil nil nil)
+		   t)))
+      (if (not (and (nth 8 s) (not (nth 3 s))))
+	  (unless noerror (error "No comment"))
+	;; We found the comment.
+	(let ((pos (point))
+	      (start (nth 8 s))
+	      (bol (line-beginning-position))
+	      (end nil))
+	  (while (and (null end) (>= (point) bol))
+	    (if (looking-at comment-start-skip)
+		(setq end (min (or limit (point-max)) (match-end 0)))
+	      (backward-char)))
+	  (goto-char (or end pos))
+	  start)))))
+
+(defun comment-search-backward (&optional limit noerror)
+  "Find a comment start between LIMIT and point.
+Moves point to inside the comment and returns the position of the
+comment-starter.  If no comment is found, moves point to LIMIT
+and raises an error or returns nil of NOERROR is non-nil."
+  ;; FIXME: If a comment-start appears inside a comment, we may erroneously
+  ;; stop there.  This can be rather bad in general, but since
+  ;; comment-search-backward is only used to find the comment-column (in
+  ;; comment-set-column) and to find the comment-start string (via
+  ;; comment-beginning) in indent-new-comment-line, it should be harmless.
+  (if (not (re-search-backward comment-start-skip limit t))
+      (unless noerror (error "No comment"))
+    (beginning-of-line)
+    (let* ((end (match-end 0))
+	   (cs (comment-search-forward end t))
+	   (pt (point)))
+      (if (not cs)
+	  (progn (beginning-of-line)
+		 (comment-search-backward limit noerror))
+	(while (progn (goto-char cs)
+		      (comment-forward)
+		      (and (< (point) end)
+			   (setq cs (comment-search-forward end t))))
+	  (setq pt (point)))
+	(goto-char pt)
+	cs))))
+
+(defun comment-beginning ()
+  "Find the beginning of the enclosing comment.
+Returns nil if not inside a comment, else moves point and returns
+the same as `comment-search-forward'."
+  ;; HACK ATTACK!
+  ;; We should really test `in-string-p' but that can be expensive.
+  (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
+    (let ((pt (point))
+	  (cs (comment-search-backward nil t)))
+      (when cs
+	(if (save-excursion
+	      (goto-char cs)
+	      (and
+	       ;; For modes where comment-start and comment-end are the same,
+	       ;; the search above may have found a `ce' rather than a `cs'.
+	       (or (not (looking-at comment-end-skip))
+		   ;; Maybe font-lock knows that it's a `cs'?
+		   (eq (get-text-property (match-end 0) 'face)
+		       'font-lock-comment-face)
+		   (unless (eq (get-text-property (point) 'face)
+			       'font-lock-comment-face)
+		     ;; Let's assume it's a `cs' if we're on the same line.
+		     (>= (line-end-position) pt)))
+	       ;; Make sure that PT is not past the end of the comment.
+	       (if (comment-forward 1) (> (point) pt) (eobp))))
+	    cs
+	  (goto-char pt)
+	  nil)))))
+
+(defun comment-forward (&optional n)
+  "Skip forward over N comments.
+Just like `forward-comment' but only for positive N
+and can use regexps instead of syntax."
+  (setq n (or n 1))
+  (if (< n 0) (error "No comment-backward")
+    (if comment-use-syntax (forward-comment n)
+      (while (> n 0)
+	(setq n
+	      (if (or (forward-comment 1)
+		      (and (looking-at comment-start-skip)
+			   (goto-char (match-end 0))
+			   (re-search-forward comment-end-skip nil 'move)))
+		  (1- n) -1)))
+      (= n 0))))
+
+(defun comment-enter-backward ()
+  "Move from the end of a comment to the end of its content.
+Point is assumed to be just at the end of a comment."
+  (if (bolp)
+      ;; comment-end = ""
+      (progn (backward-char) (skip-syntax-backward " "))
+    (let ((end (point)))
+      (beginning-of-line)
+      (save-restriction
+	(narrow-to-region (point) end)
+	(if (re-search-forward (concat comment-end-skip "\\'") nil t)
+	    (goto-char (match-beginning 0))
+	  ;; comment-end-skip not found probably because it was not set right.
+	  ;; Since \\s> should catch the single-char case, we'll blindly
+	  ;; assume we're at the end of a two-char comment-end.
+	  (goto-char (point-max))
+	  (backward-char 2)
+	  (skip-chars-backward (string (char-after)))
+	  (skip-syntax-backward " "))))))
+
+;;;;
+;;;; Commands
+;;;;
+
+;;;###autoload
+
+;; #### XEmacs had this: in place of just (current-column)
+; (defconst comment-indent-function
+;   ;; XEmacs - add at least one space after the end of the text on the
+;   ;; current line...
+;   (lambda ()
+;     (save-excursion
+;       (beginning-of-line)
+;       (let ((eol (save-excursion (end-of-line) (point))))
+; 	(and comment-start-skip
+; 	     (re-search-forward comment-start-skip eol t)
+; 	     (setq eol (match-beginning 0)))
+; 	(goto-char eol)
+; 	(skip-chars-backward " \t")
+; 	(max comment-column (1+ (current-column))))))
+;   "Function to compute desired indentation for a comment.
+; This function is called with no args with point at the beginning of
+; the comment's starting delimiter.")
+
+(defun comment-indent-default ()
+  "Default for `comment-indent-function'."
+  (if (and (looking-at "\\s<\\s<\\(\\s<\\)?")
+	   (or (match-end 1) (/= (current-column) (current-indentation))))
+      0
+    (when (or (/= (current-column) (current-indentation))
+	      (and (> comment-add 0) (looking-at "\\s<\\S<")))
+      comment-column)))
+
+;;;###autoload
+(defun comment-indent (&optional continue)
+  "Indent this line's comment to comment column, or insert an empty comment.
+If CONTINUE is non-nil, use the `comment-continue' markers if any.
+Comments starting in column 0 are not moved."
+  (interactive "*")
+  (comment-normalize-vars)
+  (let* ((empty (save-excursion (beginning-of-line)
+				(looking-at "[ \t]*$")))
+	 (starter (or (and continue comment-continue)
+		      (and empty block-comment-start) comment-start))
+	 (ender (or (and continue comment-continue "")
+		    (and empty block-comment-end) comment-end)))
+    (unless starter (error "No comment syntax defined"))
+    (beginning-of-line)
+    (let* ((eolpos (line-end-position))
+	   (begpos (comment-search-forward eolpos t))
+	   cpos indent)
+      ;; An existing comment?
+      (if begpos (setq cpos (point-marker))
+	  ;; If none, insert one.
+	  (save-excursion
+	    ;; Some comment-indent-function insist on not moving comments that
+	    ;; are in column 0, so we first go to the likely target column.
+	    (indent-to comment-column)
+	    (setq begpos (point))
+	    (insert starter)
+	    (setq cpos (point-marker))
+	    (insert ender)))
+      (goto-char begpos)
+      ;; Compute desired indent.
+      (setq indent (save-excursion (funcall comment-indent-function)))
+      (if (not indent)
+	  ;; comment-indent-function refuses delegates to indent.
+	  (indent-according-to-mode)
+	;; Avoid moving comments past the fill-column.
+	(unless (save-excursion (skip-chars-backward " \t") (bolp))
+	  (setq indent
+		(min indent
+		     (+ (current-column)
+			(- fill-column
+			   (save-excursion (end-of-line) (current-column)))))))
+        ;; XEmacs change: Preserve indentation of comments starting in
+        ;; column 0, as documented.
+	(if (or (= (current-column) 0) (= (current-column) indent))
+	    (goto-char begpos)
+	  ;; If that's different from current, change it.
+	  (skip-chars-backward " \t")
+	  (delete-region (point) begpos)
+	  (indent-to (if (bolp) indent
+		       (max indent (1+ (current-column)))))))
+      (goto-char cpos)
+      (set-marker cpos nil))))
+
+;;;###autoload
+(defun comment-set-column (arg)
+  "Set the comment column based on point.
+With no ARG, set the comment column to the current column.
+With just minus as arg, kill any comment on this line.
+With any other arg, set comment column to indentation of the previous comment
+ and then align or create a comment on this line at that column."
+  (interactive "P")
+  (cond
+   ((eq arg '-) (comment-kill nil))
+   (arg
+    (save-excursion
+      (beginning-of-line)
+      (comment-search-backward)
+      (beginning-of-line)
+      (goto-char (comment-search-forward (line-end-position)))
+      (setq comment-column (current-column))
+      (lmessage 'command "Comment column set to %d" comment-column))
+    (comment-indent))
+   (t (setq comment-column (current-column))
+      (lmessage 'command "Comment column set to %d" comment-column))))
+
+;;;###autoload
+(defun comment-kill (arg)
+  "Kill the comment on this line, if any.
+With prefix ARG, kill comments on that many lines starting with this one."
+  ;; XEmacs change: add *
+  (interactive "*P")
+  (dotimes (_ (prefix-numeric-value arg))
+    (save-excursion
+      (beginning-of-line)
+      (let ((cs (comment-search-forward (line-end-position) t)))
+	(when cs
+	  (goto-char cs)
+	  (skip-syntax-backward " ")
+	  (setq cs (point))
+	  (comment-forward)
+	  (kill-region cs (if (bolp) (1- (point)) (point)))
+	  (indent-according-to-mode))))
+    (if arg (forward-line 1))))
+
+(defun comment-padright (str &optional n)
+  "Construct a string composed of STR plus `comment-padding'.
+It also adds N copies of the last non-whitespace chars of STR.
+If STR already contains padding, the corresponding amount is
+ignored from `comment-padding'.
+N defaults to 0.
+If N is `re', a regexp is returned instead, that would match
+the string for any N."
+  (setq n (or n 0))
+  (when (and (stringp str) (not (string= "" str)))
+    ;; Separate the actual string from any leading/trailing padding
+    (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
+    (let ((s (match-string 1 str))	;actual string
+	  (lpad (substring str 0 (match-beginning 1))) ;left padding
+	  (rpad (concat (substring str (match-end 1)) ;original right padding
+			(substring comment-padding ;additional right padding
+				   (min (- (match-end 0) (match-end 1))
+					(length comment-padding)))))
+	  ;; We can only duplicate C if the comment-end has multiple chars
+	  ;; or if comments can be nested, else the comment-end `}' would
+	  ;; be turned into `}}}' where only the first ends the comment
+	  ;; and the rest becomes bogus junk.
+	  (multi (not (and comment-quote-nested
+			   ;; comment-end is a single char
+			   (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
+      (if (not (symbolp n))
+	  (concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
+	;; construct a regexp that would match anything from just S
+	;; to any possible output of this function for any N.
+	(concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
+			   lpad "")	;padding is not required
+		(regexp-quote s)
+		(when multi "+")	;the last char of S might be repeated
+		(mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
+			   rpad "")))))) ;padding is not required
+
+(defun comment-padleft (str &optional n)
+  "Construct a string composed of `comment-padding' plus STR.
+It also adds N copies of the first non-whitespace chars of STR.
+If STR already contains padding, the corresponding amount is
+ignored from `comment-padding'.
+N defaults to 0.
+If N is `re', a regexp is returned instead, that would match
+  the string for any N."
+  (setq n (or n 0))
+  (when (and (stringp str) (not (string= "" str)))
+    ;; Only separate the left pad because we assume there is no right pad.
+    (string-match "\\`\\s-*" str)
+    (let ((s (substring str (match-end 0)))
+	  (pad (concat (substring comment-padding
+				  (min (- (match-end 0) (match-beginning 0))
+				       (length comment-padding)))
+		       (match-string 0 str)))
+	  (c (aref str (match-end 0)))	;the first non-space char of STR
+	  ;; We can only duplicate C if the comment-end has multiple chars
+	  ;; or if comments can be nested, else the comment-end `}' would
+	  ;; be turned into `}}}' where only the first ends the comment
+	  ;; and the rest becomes bogus junk.
+	  (multi (not (and comment-quote-nested
+			   ;; comment-end is a single char
+			   (string-match "\\`\\s-*\\S-\\s-*\\'" comment-end)))))
+      (if (not (symbolp n))
+	  (concat pad (when multi (make-string n c)) s)
+	;; Construct a regexp that would match anything from just S
+	;; to any possible output of this function for any N.
+	;; We match any number of leading spaces because this regexp will
+	;; be used for uncommenting where we might want to remove
+	;; uncomment markers with arbitrary leading space (because
+	;; they were aligned).
+	(concat "\\s-*"
+		(if multi (concat (regexp-quote (string c)) "*"))
+		(regexp-quote s))))))
+
+;;;###autoload
+(defun uncomment-region (beg end &optional arg)
+  "Uncomment each line in the BEG..END region.
+The numeric prefix ARG can specify a number of chars to remove from the
+comment markers."
+  (interactive "*r\nP")
+  (comment-normalize-vars)
+  (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
+  (save-excursion
+    (goto-char beg)
+    (setq end (copy-marker end))
+
+    ;; XEmacs: Add the following clause
+
+    ;; if user didn't specify how many comments to remove, be smart
+    ;; and remove the minimal number that all lines have.  that way,
+    ;; comments in a region of Elisp code that gets commented out will
+    ;; get put back correctly.
+    (if (null arg)
+ 	(let ((min-comments 999999))
+ 	  (while (not (eobp))
+ 	    (let ((this-comments 0))
+ 	      (while (looking-at (regexp-quote comment-start))
+ 		(incf this-comments)
+ 		(forward-char (length comment-start)))
+ 	      (if (and (> this-comments 0) (< this-comments min-comments))
+ 		  (setq min-comments this-comments))
+ 	      (forward-line 1)))
+ 	  (if (< min-comments 999999)
+ 	      (setq arg (list min-comments)))
+ 	  (goto-char beg)))
+
+    (let ((numarg (prefix-numeric-value arg))
+	  spt)
+      (while (and (< (point) end)
+		  (setq spt (comment-search-forward end t)))
+	(let* ((ipt (point))
+	       ;; Find the end of the comment.
+	       (ept (progn
+		      (goto-char spt)
+		      (unless (comment-forward)
+			(error "Can't find the comment end"))
+		      (point)))
+	       (box nil)
+	       (ccs comment-continue)
+	       (srei (comment-padright ccs 're))
+	       (sre (and srei (concat "^\\s-*?\\(" srei "\\)"))))
+	  (save-restriction
+	    (narrow-to-region spt ept)
+	    ;; Remove the comment-start.
+	    (goto-char ipt)
+	    (skip-syntax-backward " ")
+	    ;; Check for special `=' used sometimes in comment-box.
+	    (when (and (= (- (point) (point-min)) 1) (looking-at "=\\{7\\}"))
+	      (skip-chars-forward "="))
+	    ;; A box-comment starts with a looong comment-start marker.
+	    (when (> (- (point) (point-min) (length comment-start)) 7)
+	      (setq box t))
+	    (when (looking-at (regexp-quote comment-padding))
+	      (goto-char (match-end 0)))
+	    (when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
+	      (goto-char (match-end 0)))
+	    (if (null arg) (delete-region (point-min) (point))
+	      (skip-syntax-backward " ")
+	      (delete-char (- numarg)))
+
+	    ;; Remove the end-comment (and leading padding and such).
+	    (goto-char (point-max)) (comment-enter-backward)
+	    ;; Check for special `=' used sometimes in comment-box.
+	    (when (= (- (point-max) (point)) 1)
+	      (let ((pos (point)))
+		;; skip `=' but only if there are at least 7.
+		(when (> (skip-chars-backward "=") -7) (goto-char pos))))
+	    (unless (looking-at "\\(\n\\|\\s-\\)*\\'")
+	      (when (and (bolp) (not (bobp))) (backward-char))
+	      (if (null arg) (delete-region (point) (point-max))
+		(skip-syntax-forward " ")
+		(delete-char numarg)))
+
+	    ;; Unquote any nested end-comment.
+	    (comment-quote-nested comment-start comment-end t)
+
+	    ;; Eliminate continuation markers as well.
+	    (when sre
+	      (let* ((cce (comment-string-reverse (or comment-continue
+						      comment-start)))
+		     (erei (and box (comment-padleft cce 're)))
+		     (ere (and erei (concat "\\(" erei "\\)\\s-*$"))))
+		(goto-char (point-min))
+		(while (progn
+			 (if (and ere (re-search-forward
+				       ere (line-end-position) t))
+			     (replace-match "" t t nil (if (match-end 2) 2 1))
+			   (setq ere nil))
+			 (forward-line 1)
+			 (re-search-forward sre (line-end-position) t))
+		  (replace-match "" t t nil (if (match-end 2) 2 1)))))
+	    ;; Go the the end for the next comment.
+	    (goto-char (point-max)))))
+      (set-marker end nil))))
+
+(defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block)
+  "Make the leading and trailing extra lines.
+This is used for `extra-line' style (or `box' style if BLOCK is specified)."
+  (let ((eindent 0))
+    (if (not block)
+	;; Try to match CS and CE's content so they align aesthetically.
+	(progn
+	  (setq ce (comment-string-strip ce t t))
+	  (when (string-match "\\(.+\\).*\n\\(.*?\\)\\1" (concat ce "\n" cs))
+	    (setq eindent
+		  (max (- (match-end 2) (match-beginning 2) (match-beginning 0))
+		       0))))
+      ;; box comment
+      (let* ((width (- max-indent min-indent))
+	     (s (concat cs "a=m" cce))
+	     (e (concat ccs "a=m" ce))
+	     (c (if (string-match ".*\\S-\\S-" cs)
+		    (aref cs (1- (match-end 0))) ?=))
+	     ; Huh? (_ (string-match "\\s-*a=m\\s-*" s))
+	     (fill
+	      (make-string (+ width (- (match-end 0)
+				       (match-beginning 0) (length cs) 3)) c)))
+	(setq cs (replace-match fill t t s))
+	(string-match "\\s-*a=m\\s-*" e)
+	(setq ce (replace-match fill t t e))))
+    (cons (concat cs "\n" (make-string min-indent ? ) ccs)
+	  (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce))))
+
+;(def-edebug-spec comment-with-narrowing t)
+(put 'comment-with-narrowing 'lisp-indent-function 2)
+(defmacro comment-with-narrowing (beg end &rest body)
+  "Execute BODY with BEG..END narrowing.
+Space is added (and then removed) at the beginning for the text's
+indentation to be kept as it was before narrowing."
+  (let ((bindent (make-symbol "bindent")))
+    `(let ((,bindent (save-excursion (goto-char beg) (current-column))))
+       (save-restriction
+	 (narrow-to-region beg end)
+	 (goto-char (point-min))
+	 (insert (make-string ,bindent ? ))
+	 (prog1
+	     (progn ,@body)
+	   ;; remove the bindent
+	   (save-excursion
+	     (goto-char (point-min))
+	     (when (looking-at " *")
+	       (let ((n (min (- (match-end 0) (match-beginning 0)) ,bindent)))
+		 (delete-char n)
+		 (setq ,bindent (- ,bindent n))))
+	     (end-of-line)
+	     (let ((e (point)))
+	       (beginning-of-line)
+	       (while (and (> ,bindent 0) (re-search-forward "   *" e t))
+		 (let ((n (min ,bindent (- (match-end 0) (match-beginning 0) 1))))
+		   (goto-char (match-beginning 0))
+		   (delete-char n)
+		   (setq ,bindent (- ,bindent n)))))))))))
+
+(defun comment-region-internal (beg end cs ce
+				    &optional ccs cce block lines indent)
+  "Comment region BEG..END.
+CS and CE are the comment start resp end string.
+CCS and CCE are the comment continuation strings for the start resp end
+of lines (default to CS and CE).
+BLOCK indicates that end of lines should be marked with either CCE, CE or CS
+\(if CE is empty) and that those markers should be aligned.
+LINES indicates that an extra lines will be used at the beginning and end
+of the region for CE and CS.
+INDENT indicates to put CS and CCS at the current indentation of the region
+rather than at left margin."
+  ;;(assert (< beg end))
+  (let ((no-empty t))
+    ;; Sanitize CE and CCE.
+    (if (and (stringp ce) (string= "" ce)) (setq ce nil))
+    (if (and (stringp cce) (string= "" cce)) (setq cce nil))
+    ;; If CE is empty, multiline cannot be used.
+    (unless ce (setq ccs nil cce nil))
+    ;; Should we mark empty lines as well ?
+    (if (or ccs block lines) (setq no-empty nil))
+    ;; Make sure we have end-markers for BLOCK mode.
+    (when block (unless ce (setq ce (comment-string-reverse cs))))
+    ;; If BLOCK is not requested, we don't need CCE.
+    (unless block (setq cce nil))
+    ;; Continuation defaults to the same as CS and CE.
+    (unless ccs (setq ccs cs cce ce))
+    
+    (save-excursion
+      (goto-char end)
+      ;; If the end is not at the end of a line and the comment-end
+      ;; is implicit (i.e. a newline), explicitly insert a newline.
+      (unless (or ce (eolp)) (insert "\n") (indent-according-to-mode))
+      (comment-with-narrowing beg end
+	(let ((min-indent (point-max))
+	      (max-indent 0))
+	  (goto-char (point-min))
+	  ;; Quote any nested comment marker
+	  (comment-quote-nested comment-start comment-end nil)
+
+	  ;; Loop over all lines to find the needed indentations.
+	  (goto-char (point-min))
+	  (while
+	      (progn
+		(unless (looking-at "[ \t]*$")
+		  (setq min-indent (min min-indent (current-indentation))))
+		(end-of-line)
+		(setq max-indent (max max-indent (current-column)))
+		(not (or (eobp) (progn (forward-line) nil)))))
+	  
+	  ;; Inserting ccs can change max-indent by (1- tab-width).
+	  (setq max-indent
+		(+ max-indent (max (length cs) (length ccs)) tab-width -1))
+	  (unless indent (setq min-indent 0))
+
+	  ;; make the leading and trailing lines if requested
+	  (when lines
+	    (let ((csce
+		   (comment-make-extra-lines
+		    cs ce ccs cce min-indent max-indent block)))
+	      (setq cs (car csce))
+	      (setq ce (cdr csce))))
+	  
+	  (goto-char (point-min))
+	  ;; Loop over all lines from BEG to END.
+	  (while
+	      (progn
+		(unless (and no-empty (looking-at "[ \t]*$"))
+		  (move-to-column min-indent t)
+		  (insert cs) (setq cs ccs) ;switch to CCS after the first line
+		  (end-of-line)
+		  (if (eobp) (setq cce ce))
+		  (when cce
+		    (when block (move-to-column max-indent t))
+		    (insert cce)))
+		(end-of-line)
+		(not (or (eobp) (progn (forward-line) nil))))))))))
+
+;;;###autoload
+(defun comment-region (beg end &optional arg)
+  "Comment or uncomment each line in the region.
+With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END.
+Numeric prefix arg ARG means use ARG comment characters.
+If ARG is negative, delete that many comment characters instead.
+By default, comments start at the left margin, are terminated on each line,
+even for syntax in which newline does not end the comment and blank lines
+do not get comments.  This can be changed with `comment-style'.
+
+The strings used as comment starts are built from
+`comment-start' without trailing spaces and `comment-padding'."
+  (interactive "*r\nP")
+  (comment-normalize-vars)
+  (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
+  (let* ((numarg (prefix-numeric-value arg))
+	 (add comment-add)
+	 (style (cdr (assoc comment-style comment-styles)))
+	 (lines (nth 2 style))
+	 (block (nth 1 style))
+	 (multi (nth 0 style)))
+    (save-excursion
+      ;; we use `chars' instead of `syntax' because `\n' might be
+      ;; of end-comment syntax rather than of whitespace syntax.
+      ;; sanitize BEG and END
+      (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
+      (setq beg (max beg (point)))
+      (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
+      (setq end (min end (point)))
+      (if (>= beg end) (error "Nothing to comment"))
+
+      ;; sanitize LINES
+      (setq lines
+	    (and
+	     lines ;; multi
+	     (progn (goto-char beg) (beginning-of-line)
+		    (skip-syntax-forward " ")
+		    (>= (point) beg))
+	     (progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
+		    (<= (point) end))
+	     (or (not (string= "" comment-end)) block)
+	     (progn (goto-char beg) (search-forward "\n" end t)))))
+
+    ;; don't add end-markers just because the user asked for `block'
+    (unless (or lines (string= "" comment-end)) (setq block nil))
+
+    (cond
+     ((consp arg) (uncomment-region beg end))
+     ((< numarg 0) (uncomment-region beg end (- numarg)))
+     (t
+      (setq numarg (if (and (null arg) (= (length comment-start) 1))
+		       add (1- numarg)))
+      (comment-region-internal
+       beg end
+       (let ((s (comment-padright comment-start numarg)))
+	 (if (string-match comment-start-skip s) s
+	   (comment-padright comment-start)))
+       (let ((s (comment-padleft comment-end numarg)))
+	 (and s (if (string-match comment-end-skip s) s
+		  (comment-padright comment-end))))
+       (if multi (comment-padright comment-continue numarg))
+       (if multi (comment-padleft (comment-string-reverse comment-continue) numarg))
+       block
+       lines
+       (nth 3 style))))))
+
+(defun comment-box (beg end &optional arg)
+  "Comment out the BEG..END region, putting it inside a box.
+The numeric prefix ARG specifies how many characters to add to begin- and
+end- comment markers additionally to what `comment-add' already specifies."
+  (interactive "*r\np")
+  (let ((comment-style (if (cadr (assoc comment-style comment-styles))
+			   'box-multi 'box)))
+    (comment-region beg end (+ comment-add arg))))
+
+;;;###autoload
+(defun comment-dwim (arg)
+  "Call the comment command you want (Do What I Mean).
+If the region is active and `transient-mark-mode' is on, call
+  `comment-region' (unless it only consists of comments, in which
+  case it calls `uncomment-region').
+Else, if the current line is empty, insert a comment and indent it.
+Else if a prefix ARG is specified, call `comment-kill'.
+Else, call `comment-indent'."
+  (interactive "*P")
+  (comment-normalize-vars)
+  (if (region-active-p) ;mark-active transient-mark-mode)
+      (let ((beg (min (point) (mark)))
+	    (end (max (point) (mark))))
+	(if (save-excursion ;; check for already commented region
+	      (goto-char beg)
+	      (comment-forward (point-max))
+	      (<= end (point)))
+	    (uncomment-region beg end arg)
+	  (comment-region beg end arg)))
+    (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
+	;; FIXME: If there's no comment to kill on this line and ARG is
+	;; specified, calling comment-kill is not very clever.
+	(if arg (comment-kill (and (integerp arg) arg)) (comment-indent))
+      (let ((add (if arg (prefix-numeric-value arg)
+		   (if (= (length comment-start) 1) comment-add 0))))
+	;; Some modes insist on keeping column 0 comment in column 0
+	;; so we need to move away from it before inserting the comment.
+	(indent-according-to-mode)
+	(insert (comment-padright comment-start add))
+	(save-excursion
+	  (unless (string= "" comment-end)
+	    (insert (comment-padleft comment-end add)))
+	  (indent-according-to-mode))))))
+
+(defcustom comment-auto-fill-only-comments nil
+  "Non-nil means to only auto-fill inside comments.
+This has no effect in modes that do not define a comment syntax."
+  :type 'boolean
+  :group 'comment)
+
+;;;###autoload
+(defun comment-indent-new-line (&optional soft)
+  "Break line at point and indent, continuing comment if within one.
+This indents the body of the continued comment
+under the previous comment line.
+
+This command is intended for styles where you write a comment per line,
+starting a new comment (and terminating it if necessary) on each line.
+If you want to continue one comment across several lines, use \\[newline-and-indent].
+
+If a fill column is specified, it overrides the use of the comment column
+or comment indentation.
+
+The inserted newline is marked hard if variable `use-hard-newlines' is true,
+unless optional argument SOFT is non-nil."
+  (interactive)
+  (comment-normalize-vars t)
+  (let (compos comin)
+    ;; If we are not inside a comment and we only auto-fill comments,
+    ;; don't do anything (unless no comment syntax is defined).
+    (unless (and comment-start
+		 comment-auto-fill-only-comments
+		 (not (save-excursion
+			(prog1 (setq compos (comment-beginning))
+			  (setq comin (point))))))
+
+      ;; Now we know we should auto-fill.
+      ;; XEmacs: next 3 lines from old version.
+      (skip-chars-backward " \t")
+      (if (featurep 'mule)
+	  (declare-fboundp (kinsoku-process)))
+      (delete-horizontal-space)
+      (if soft (insert-and-inherit ?\n) (newline 1))
+      (if fill-prefix
+	  (progn
+	    (indent-to-left-margin)
+	    (insert-and-inherit fill-prefix))
+
+	;;#### jhod: probably need to fix this for kinsoku processing
+	;; If necessary check whether we're inside a comment.
+	(unless (or comment-multi-line compos (null comment-start))
+	  (save-excursion
+	    (backward-char)
+	    (setq compos (comment-beginning))
+	    (setq comin (point))))
+
+	;; If we're not inside a comment, just try to indent.
+	;; #### XEmacs: the line `(if comcol' was changed as follows.
+	;; I'm leaving it out since who knows if it's applicable any more.
+	;; --ben
+	;; (if (and comcol (not fill-prefix))  ; XEmacs - (ENE) from fa-extras.
+	(if (not compos) (indent-according-to-mode)
+	  (let* ((comment-column
+		  ;; The continuation indentation should be somewhere between
+		  ;; the current line's indentation (plus 2 for good measure)
+		  ;; and the current comment's indentation, with a preference
+		  ;; for comment-column.
+		  (save-excursion
+		    (goto-char compos)
+		    (min (current-column) (max comment-column
+					       (+ 2 (current-indentation))))))
+		 (comstart (buffer-substring compos comin))
+		 (normalp
+		  (string-match (regexp-quote (comment-string-strip
+					       comment-start t t))
+				comstart))
+		 (comment-end
+		  (if normalp comment-end
+		    ;; The comment starter is not the normal comment-start
+		    ;; so we can't just use comment-end.
+		    (save-excursion
+		      (goto-char compos)
+		      (if (not (comment-forward)) comment-end
+			(comment-string-strip
+			 (buffer-substring
+			  (save-excursion (comment-enter-backward) (point))
+			  (point))
+			 nil t)))))
+		 (comment-start comstart)
+		 ;; Force comment-continue to be recreated from comment-start.
+		 ;; FIXME: wrong if comment-continue was set explicitly!
+		 (comment-continue nil))
+	    (insert-and-inherit ?\n)
+	    (forward-char -1)
+	    (comment-indent (cadr (assoc comment-style comment-styles)))
+	    (save-excursion
+	      (let ((pt (point)))
+		(end-of-line)
+		(let ((comend (buffer-substring pt (point))))
+		  ;; The 1+ is to make sure we delete the \n inserted above.
+		  (delete-region pt (1+ (point)))
+		  (beginning-of-line)
+		  (backward-char)
+		  (insert comend)
+		  (forward-char))))))))))
+
+(provide 'newcomment)
+
+;;; newcomment.el ends here