show-wspace.el - whitespace highlighting

[Drew Adams]

;;; show-wspace.el --- Highlight whitespace.
;;
;; Filename: show-wspace.el
;; Description: Highlight whitespace.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 2000, 2001, Drew Adams, all rights reserved.
;; Created: Wed Jun 21 08:54:53 2000
;; Version: $Id: show-wspace.el,v 1.3 2001/01/09 22:19:30 dadams Exp $
;; Last-Updated: Tue Jan  9 14:19:18 2001
;;           By: dadams
;;     Update #: 117
;; Keywords: highlight
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;    Highlight whitespace.
;;
;; New user options (variables) defined here:
;;
;;    `highlight-hard-spaces-p', `highlight-tabs-p',
;;    `highlight-trailing-whitespace-p', `pesche-hardspace-face',
;;    `pesche-space-face', `pesche-tab-face'.
;;
;; New functions defined here:
;;
;;    `highlight-hard-spaces', `highlight-tabs',
;;    `highlight-trailing-whitespace', `toggle-hardspace-font-lock',
;;    `toggle-tabs-font-lock', `toggle-trailing-whitespace-font-lock'.
;;
;;
;; Mea culpa: I picked up the basic code of this from someone else,
;; but I don't remember whom.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; RCS $Log: show-wspace.el,v $
;; RCS Revision 1.3  2001/01/09 22:19:30  dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.2  2001/01/03 01:13:13  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.1  2000/09/14 17:24:04  dadams
;; RCS Initial revision
;; RCS
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:


(require 'cl) ;; when, push

;; Get macro `define-face-const' when this is compiled,
;; or run interpreted, but not when the compiled code is loaded.
(eval-when-compile (require 'def-face-const))


(provide 'show-wspace)

;;;;;;;;;;;;;;;;;;;;;;;;;



(unless (boundp 'lemonchiffon-background-face)
  (define-face-const nil "LemonChiffon"))
(unless (boundp 'gold-background-face)
  (define-face-const nil "Gold"))
(unless (boundp 'palegreen-background-face)
  (define-face-const nil "PaleGreen"))

;;;###autoload
(defvar pesche-tab-face lemonchiffon-background-face
  "*Face for highlighting tab characters (C-i) in Font-Lock mode.")
;;;###autoload
(defvar pesche-space-face gold-background-face
  "*Face for highlighting whitespace at line ends in Font-Lock mode.")
;;;###autoload
(defvar pesche-hardspace-face palegreen-background-face                 
  "*Face for highlighting hard spaces (\040)in Font-Lock mode.")

(defvar highlight-tabs-p nil
  "*Non-nil <=> Font-Lock mode is highlighting TABs (C-i).")
(defvar highlight-trailing-whitespace-p nil
  "*Non-nil <=> Font-Lock mode is highlighting whitespace at line ends.")
(defvar highlight-hard-spaces-p nil
  "*Non-nil <=> Font-Lock mode is highlighting hard spaces (\040)")

(defun highlight-tabs ()          
  (push '("[\t]+" (0 pesche-tab-face t)) font-lock-keywords))
(defun highlight-hard-spaces ()
  (push '("[\240]+" (0 pesche-hardspace-face t)) font-lock-keywords))
(defun highlight-trailing-whitespace ()
  (push '("[\040\t]+$" (0 pesche-space-face t)) font-lock-keywords))

;;;###autoload
(defun toggle-tabs-font-lock ()
  "Toggle highlighting of TABs."
  (interactive)
  (if highlight-tabs-p
      (remove-hook 'font-lock-mode-hook 'highlight-tabs)
    (add-hook 'font-lock-mode-hook 'highlight-tabs))
  (setq highlight-tabs-p (not highlight-tabs-p))
  (font-lock-mode)(font-lock-mode)
  (message "TAB highlighting is now %s." (if highlight-tabs-p "ON" "OFF")))

;;;###autoload
(defun toggle-hardspace-font-lock ()
  "Toggle highlighting of hard SPACE characters."
  (interactive)
  (if highlight-hard-spaces-p
      (remove-hook 'font-lock-mode-hook 'highlight-hard-spaces)
    (add-hook 'font-lock-mode-hook 'highlight-hard-spaces))
  (setq highlight-hard-spaces-p (not highlight-hard-spaces-p))
  (font-lock-mode)(font-lock-mode)
  (message "Hard space highlighting is now %s."
           (if highlight-hard-spaces-p "ON" "OFF")))

;;;###autoload
(defun toggle-trailing-whitespace-font-lock ()
  "Toggle highlighting of trailing whitespace."
  (interactive)
  (if highlight-trailing-whitespace-p 
      (remove-hook 'font-lock-mode-hook 'highlight-trailing-whitespace)
    (add-hook 'font-lock-mode-hook 'highlight-trailing-whitespace))
  (setq highlight-trailing-whitespace-p (not highlight-trailing-whitespace-p))
  (font-lock-mode)(font-lock-mode)
  (message "Trailing whitespace highlighting is now %s."
           (if highlight-trailing-whitespace-p "ON" "OFF")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `show-wspace.el' ends here