;;; highlight.el --- highlight/unhighlight buffer regions

;; Copyright (C) 1996 Noah S. Friedman

;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
;; Maintainer: friedman@prep.ai.mit.edu
;; Keywords: extensions
;; Created: 1996-12-30

;; $Id: highlight.el,v 1.1 1997/01/10 23:05:20 friedman Exp $

;; This program 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.
;;
;; This program 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 this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:
;;; Code:

(defun highlight-region (beg end &optional buffer)
  (interactive "r")
  (let ((ovl (make-overlay beg end buffer)))
    (overlay-put ovl 'face 'highlight)))

(defun unhighlight-region (point)
  (interactive "d")
  (let ((ovls (overlays-at point)))
    (while ovls
      (unhighlight-overlay (car ovls))
      (setq ovls (cdr ovls)))))

;; Delete overlay if the only extant property was for highlighting.
(defun unhighlight-overlay (ovl)
  (let* ((props (overlay-properties ovl))
         (faces (overlay-get ovl 'face)))
    (cond ((or (null props)
               (and (eq (car props) 'face)
                    (null (cdr (cdr props)))
                    (or (null faces)
                        (eq faces 'highlight))))
           (delete-overlay ovl))

          ((eq faces 'highlight)
           (overlay-put ovl 'face nil))

          ((listp faces)
           (setq faces (delq 'highlight faces))
           (overlay-put ovl 'face faces)))))


(defun unhighlight-buffer ()
  (interactive)
  (let ((ovls (overlays-in (point-min) (point-max))))
    (while ovls
      (unhighlight-overlay (car ovls))
      (setq ovls (cdr ovls)))))

(provide 'highlight)

;;; highlight.el ends here