InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/elisp/misc/comm-regn.el

Text File | 1990-03-21 | 10.7 KB | 286 lines

;From ark1!nems!mimsy!haven!umbc3!kochab.cs.umbc.edu!cdwilli Sat Dec  9 23:50:48 EST 1989
;Article 1011 of comp.emacs:
;Path: ark1!nems!mimsy!haven!umbc3!kochab.cs.umbc.edu!cdwilli
;>From: [e-mail]
;Newsgroups: comp.emacs
;Subject: Commenting and Uncommenting C and Lisp in Gnu Emacs...
;Message-ID: <[e-mail]>
;Date: 8 Dec 89 03:02:56 GMT
;Sender: [e-mail]
;Reply-To: [e-mail] ()
;Distribution: na
;Organization: University of Maryland Baltimore County
;Lines: 271
;
;
;
;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))