cdwilli@kochab.cs.umbc.edu (12/09/89)
Original-posting-by: cdwilli@kochab.cs.umbc.edu
Reposted-by: emv@math.lsa.umich.edu (Edward Vielmetti)
Posting-id: 891208.1922
Posting-number: Volume TEST, Number TEST
Archive-name: comment-region, uncomment-region for gnu emacs in C and Lisp modes
[This is an experimental alt.sources re-posting from the
newsgroup(s) comp.emacs.
No attempt has been made to edit, clean, modify, or otherwise
change the contents of the original posting, or to contact the
author. Please consider cross-posting all sources postings to
alt.sources as a matter of course.]
[Comments on this service to emv@math.lsa.umich.edu (Edward Vielmetti)]
Have you ever wanted to comment out a block of C or Lisp code
while using GNU EMACS? Two functions, (comment-region) and
(uncomment-region), make this easy. In C, they check for nesting
of comments as well as unbalanced delimiters. Try them out by
marking a region of code, then typing M-x comment-region, M-x
uncomment-region.
;;; COMMENT-REGION -- The user sets the mark (CTRL-@), then moves the
;;; point (cursor) to another place in the buffer. He then types M-x
;;; comment-region. The area between the mark and the cursor is
;;; commented in the appropriate style depending on what mode the
;;; buffer is in (currently Lisp, EMACS Lisp, and C modes are working).
;;; UNCOMMENT-REGION -- Does the reverse of comment-region.
;;;
;;; HOW TO USE THESE FUNCTIONS:
;;; Type M-x load-file <return>, give the name of this file and
;;; <return>. Now, if you want to comment some code, move the cursor
;;; to a point in the buffer, then set a mark (CTRL-@). Move the
;;; cursor again to specify a region to comment, then type M-x
;;; comment-region <return>.
;;; To uncomment code, specify a region as described above, then type
;;; M-x uncomment-region <return>.
;;; Lisp commenting works line-by-line, commenting out whole lines at
;;; a time. C commenting, on ;the other hand, looks for uncommented
;;; regions within the whole region to be commented (the C compiler
;;; doesn't allow nesting of comments, so we have to search for any
;;; comments already in the region).
;;; TO DO: This program can be extended to include GNU's
;;; fortran-comment-region. One needs to write a
;;; fortran-uncomment-region as well.
(defun comment-region ()
"Insert the proper comment characters into the region of a program.
Used to comment blocks of Lisp or C code."
(interactive)
(let ((start-position (make-marker))
(end-position (make-marker)))
(set-marker start-position (mark))
(set-marker end-position (point))
(cond ((or (eq major-mode 'lisp-mode) (eq major-mode 'emacs-lisp-mode))
(comment-lines start-position end-position 'comment-lisp-line)
(goto-char (marker-position end-position)))
((eq major-mode 'c-mode)
(c-comment-region start-position end-position))
(t (error "Don't know how to comment %s mode." major-mode)))))
(defun uncomment-region ()
"Remove comment delimiters from a region of code. Works with
comments created by function comment-region. Lisp or C."
(interactive)
(let ((start-position (make-marker))
(end-position (make-marker))
(final-position (make-marker)))
(set-marker start-position (mark))
(set-marker end-position (point))
(set-marker final-position end-position)
(cond ((or (eq major-mode 'lisp-mode) (eq major-mode 'emacs-lisp-mode))
(comment-lines start-position end-position 'uncomment-lisp-line)
(goto-char (marker-position end-position)))
((eq major-mode 'c-mode)
(c-uncomment-region start-position end-position))
(t (error "Don't know how to uncomment %s mode." major-mode)))))
;;; ****************************************************************
;;; LISP COMMENTING AND UNCOMMENTING FUNCTIONS
;;; ****************************************************************
;;; Loop through, commenting each line.
(defun comment-lines (start-position end-position comment-function)
(save-excursion
(let ((number-of-lines-to-comment (count-lines start-position end-position)))
(goto-char start-position)
(while (> number-of-lines-to-comment 0)
(beginning-of-line)
(funcall comment-function)
(setq number-of-lines-to-comment
(- number-of-lines-to-comment 1))
(go-to-next-line start-position end-position)))))
;;; Go forward or backward one line, depending on values of start and end.
(defun go-to-next-line (start end)
(cond ((< start end) (next-line 1))
((> start end) (next-line -1))))
;;; Comment the current-line using Lisp commenting rules.
(defun comment-lisp-line ()
(beginning-of-line)
(insert ";;; "))
(defun uncomment-lines (start-position end-position uncomment-function)
(save-excursion
(let ((number-of-lines-to-uncomment
(count-lines start-position end-position)))
(goto-char start-position)
(while (> number-of-lines-to-uncomment 0)
(beginning-of-line)
(funcall uncomment-function)
(setq number-of-lines-to-uncomment
(- number-of-lines-to-uncomment 1))
(go-to-next-line start-position end-position)))))
;;; Replace all semicolons at the beginning of the line up to a space.
;;; If a space is left after the point, delete that, too.
(defun uncomment-lisp-line ()
(beginning-of-line)
(delete-semicolons (point))
(if (string-equal (char-to-string (char-after (point)))
" ")
(delete-char 1)))
(defun delete-semicolons (point)
(while (string-equal (char-to-string (char-after (point)))
";")
(delete-char 1)))
;;;****************************************************************
;;; C COMMENTING AND UNCOMMENTING FUNCTIONS.
;;;****************************************************************
(defun c-comment-region (start end)
;; If region has been marked from the bottom to the top of the buffer,
;; switch to start and end points.
(if (> start end)
(let ((temp start))
(setq start end)
(setq end temp)))
;; Check for nothing marked. If something marked, check whether the
;; region contains any comments already. If it doesn't, do a simple
;; comment of a region. If it does, check whether it has any
;; unbalanced or unnested comments.
(if (not (= start end)) ;No commenting an empty region.
(cond ((not (c-comments-present-p start end))
(simple-c-comment start end))
((and (balanced-unnested-c-comments-p "/*$" "$*/" start end)
(balanced-unnested-c-comments-p "/*" "*/" start end))
(c-comment-uncommented-regions start end)))))
;;; This is the mate to c-comment-region. It first checks for
;;; unbalanced and nested comment delimiters, then, if all is well, it
;;; deletes all occurrences of "/*$" and "$*/".
(defun c-uncomment-region (start end)
;; If region has been marked from the bottom to the top of the
;; buffer, switch start and end points.
(if (> start end)
(let ((temp start))
(setq start end)
(setq end temp)))
(if (not (= start end))
(cond ((not (c-comments-present-p start end))
(message "No comments in region."))
((and (balanced-unnested-c-comments-p
"/*$" "$*/" start end)
(balanced-unnested-c-comments-p
"/*" "*/" start end))
(c-uncomment-commented-regions start end)))))
(defun c-uncomment-commented-regions (start end)
"Takes two markers that delimit a region and removes any C comment
delimiters involving $."
(let ((original-point (point-marker)))
(goto-char (marker-position start))
(while (search-forward "/*$" end t)
(goto-char (- (point) 3))
(delete-char 3)
(cond
((search-forward "$*/" (marker-position end) t)
(goto-char (- (point) 3))
(delete-char 3))
(t (error "Unbalanced C delimiters. Missing %s." "$*/"))))
(goto-char (marker-position original-point))))
(defun c-comments-present-p (start end)
(or (first-string-occurrence "/*" start end)
(first-string-occurrence "*/" start end)))
(defun first-string-occurrence (string start end)
(let (string-present)
(if (markerp start)
(goto-char (marker-position start))
(goto-char start))
(if (markerp end)
(setq string-present (search-forward string (marker-position
end) t))
(setq string-present (search-forward string end t)))
(if string-present
(setq string-present (point)))
string-present))
(defun c-comment-uncommented-regions (start end)
(let ((m1 (make-marker))
(m2 (make-marker)))
(set-marker m1 start)
(set-marker m2 end)
(while (not (= m1 m2))
(let ((m3 (make-marker)))
;; Find the beginning of a comment.
(set-marker m3 (first-string-occurrence "/*" m1 m2))
(cond ((marker-position m3)
(set-marker m3 (- m3 2))
(simple-c-comment m1 m3)
(set-marker m1 (first-string-occurrence "*/" m3 m2))
(if (not (marker-position m1))
(setq m1 m2)))
(t (simple-c-comment m1 m2)
(setq m1 m2)))))))
;;; Place "/*$" at the beginning of region and "$*/" at the end.
;;; Leave the point as it was.
(defun simple-c-comment (start end)
"Takes two markers that delimit region. Comments a region with C
comment delimiters. Assumes no comments already in region."
(let ((original-point (point-marker))
(begin-comment "/*$")
(end-comment "$*/"))
(goto-char (marker-position start))
(skip-chars-forward "[\t\n ]*" (marker-position end))
(set-marker start (point))
(cond ((not (= start end))
(insert begin-comment)
(goto-char (marker-position end))
(skip-chars-backward "[\t\n ]*")
(insert end-comment)
(goto-char (point)))
(t nil))))
(defun balanced-unnested-c-comments-p (left right start end)
(balanced-but-unnested-aux left right start end))
(defun balanced-but-unnested-aux (first second start end)
(let* ((first-delimiter-list
(find-closest-string start end first second))
(first-delimiter (car first-delimiter-list))
(first-delimiter-location (car (cdr first-delimiter-list))))
(if first-delimiter
(if (string-equal first-delimiter first)
(let* ((next-delimiter-list
(find-closest-string
first-delimiter-location end first second))
(next-delimiter (car next-delimiter-list))
(next-delimiter-location (car (cdr next-delimiter-list))))
(if next-delimiter-list
(if (string-equal next-delimiter second)
(balanced-but-unnested-aux
first second next-delimiter-location end)
(error "Unbalanced delimiters. Extra %s." first))
(error "Unbalanced delimiters. %s missing." second)))
(error "Unbalanced delimiters. %s missing." first))
t)))
(defun find-closest-string (start end &rest string-list)
(let ((closest (+ end 1))
(current-string ""))
(while string-list
(let ((distance (first-string-occurrence (car string-list)
start end)))
(if distance
(if (< distance closest)
(progn
(setq closest distance)
(setq current-string (car string-list)))))
(setq string-list (cdr string-list))))
(if (null-string current-string)
nil
(list current-string closest))))
(defun null-string (s) (string-equal "" s))