cgit.sxemacs.org Git - packages/blob - xemacs-packages/text-modes/whitespace-visual-mode.el

   1 ;;; whitespace-visual-mode.el -- minor mode for making whitespace visible
   2
   3 ;; Copyright (C) 1994 - 2005 Dr. Heiko Muenkel
   4
   5 ;; Author: Dr. Heiko Muenkel <muenkel@tnt.uni-hannover.de>
   6 ;; Keywords: modes, extensions
   7
   8 ;; This file is part of XEmacs.
   9
  10 ;;  XEmacs is free software; you can redistribute it and/or modify it
  11 ;;  under the terms of the GNU General Public License as published by
  12 ;;  the Free Software Foundation; either version 2, or (at your
  13 ;;  option) any later version.
  14
  15 ;;  XEmacs is distributed in the hope that it will be useful, but
  16 ;;  WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;;  General Public License for more details.
  19
  20 ;;  You should have received a copy of the GNU General Public License
  21 ;;  along with XEmacs; if not, write to the Free Software
  22 ;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23 ;;  02111-1307, USA.
  24
  25 ;;; Synched up with: [[ FSF 19.34. ]] Not in FSF.
  26
  27 ;;; Commentary:
  28
  29 ;; $Id: whitespace-visual-mode.el,v 1.1 2005-02-14 21:28:06 viteno Exp $
  30 ;; Description:
  31 ;;
  32 ;;      This is a minor mode, which highlights whitespaces (blanks and
  33 ;;      tabs) with different faces, so that it is easier to
  34 ;;      distinguish between them.
  35 ;;      Toggle the mode with: M-x whitespace-visual-mode
  36 ;;      or with: M-x whitespace-visual-incremental-mode
  37 ;;      The second one should be used in big files.
  38 ;;
  39 ;;      If you want to know how the whitespaces are highlighted then
  40 ;;      type: M-x whitespace-visual-show-faces
  41 ;;
  42 ;;      There are 2 hook variables `whitespace-visual-incremental-mode-hook'
  43 ;;      and `whitespace-visual-mode-hook' to customize the mode.
  44 ;;
  45 ;;      Look at the variable `whitespace-visual-chars', if you only want to
  46 ;;      highlight tabs or blanks and not both.
  47 ;;
  48 ;;      Set `whitespace-visual-install-toolbar-icon' to t, if you want a
  49 ;;      toolbar icon for this mode.
  50 ;;
  51 ;;      Set `whitespace-visual-install-submenu' to t, if you want a submenu
  52 ;;      for this mode. Sorry, at the moment there is no menu for the
  53 ;;      GNU Emacs.
  54 ;;
  55 ;;      Thanks to Mike Scheidler for the toolbar icon code.
  56 ;;
  57 ;; Changes:
  58 ;;      2005-02-10:
  59 ;;      The prefix of the package is now whitespace-visual
  60 ;;      instead of only whitespace. The new prefix whitespace-visual
  61 ;;      was choosen to avoid conflicts with another package called
  62 ;;      whitespace. Adding a whitespace toolbar icon should now work
  63 ;;      again. The whitespace submenu is now in the "Tools" menu
  64 ;;      instead of the old Apps menu.
  65 ;;
  66 ;; Installation:
  67 ;;
  68 ;;      This file is part of the XEmacs package system. The following
  69 ;;      instructions belong to older versions of this mode.
  70 ;;
  71 ;;      Put the files whitespace-visual-mode.el and adapt.el in one of your
  72 ;;      load-path directories and the following lines (without the
  73 ;;      comment signs) in your .emacs (adapt.el is already in the
  74 ;;      XEmacs 19.12).
  75 ;;
  76 ;;     (autoload 'whitespace-visual-mode "whitespace-visual-mode"
  77 ;;       "Toggle whitespace visual mode.
  78 ;;      With arg, turn whitespace visual mode on iff arg is positive.
  79 ;;      In whitespace visual mode the different whitespaces (tab, blank return)
  80 ;;      are highlighted with different faces. The faces are:
  81 ;;      `whitespace-visual-blank-face', `whitespace-visual-tab-face' and
  82 ;;      `whitespace-visual-return-face'."
  83 ;;      t)
  84 ;;
  85 ;;     (autoload 'whitespace-visual-incremental-mode "whitespace-visual-mode"
  86 ;;        "Toggle whitespace visual incremental mode.
  87 ;;      With arg, turn whitespace visual incremental mode on iff
  88 ;;      arg is positive. In whitespace visual incremental mode
  89 ;;      the different whitespaces (tab and blank) are highlighted with
  90 ;;      different faces. The faces are: `whitespace-blank-face' and
  91 ;;      `whitespace-visual-tab-face'. Use the command
  92 ;;      `whitespace-visual-show-faces' to show their values.
  93 ;;      In this mode only these tabs and blanks are highlighted, which are in
  94 ;;      the region from (point) - (window-height) to (point) +
  95 ;;      (window-height)."
  96
  97 ;;; Code:
  98
  99 (provide 'whitespace-visual-mode)
 100 ;; We don't need adapt
 101 ;; (require 'adapt)
 102
 103 ;;; variables:
 104
 105 (defgroup whitespace-visual nil
 106   "Minor mode for making whitespaces visible"
 107   :group 'outlines
 108   :group 'matching)
 109
 110
 111 (defcustom whitespace-visual-mode nil
 112   "Non-nil, if the `whitespace-visual-mode' is active."
 113   :type 'boolean
 114   :set (lambda (symbol value)
 115          (whitespace-visual-mode (or value 0)))
 116   :require 'whitespace-visual-mode
 117   :initialize 'custom-initialize-default
 118   :group 'whitespace-visual)
 119
 120 (make-variable-buffer-local 'whitespace-visual-mode)
 121
 122 ;;;###autoload
 123 (defcustom whitespace-visual-mode-line-string " WSP"
 124   "*String displayed on the modeline when whitespace-visual-mode is active.
 125 Set this to nil if you don't want a modeline indicator."
 126   :group 'whitespace-visual
 127   :type 'string)
 128
 129 ;;;###autoload
 130 (defcustom whitespace-visual-incremental-mode-line-string " WSPI"
 131   "*String displayed on the modeline when whitespace-visual-incremental-mode
 132 is active. Set this to nil if you don't want a modeline indicator."
 133   :group 'whitespace-visual
 134   :type 'string)
 135
 136 (defcustom whitespace-visual-chars 'tabs-and-blanks
 137   "*Determines, which whitespaces are highlighted.
 138 Valid values are:
 139 'tabs-and-blanks => tabs and blanks are highlighted;
 140 'tabs            => only tabs are highlighted;
 141 'blanks          => only blanks are highlighted;.
 142
 143 Changing this variable during the whitespace-visual-*-mode is active could lead
 144 to wrong highlighted whitespaces."
 145   :type '(radio (const tabs-and-blanks)
 146                 (const tabs)
 147                 (const blanks))
 148   :group 'whitespace-visual)
 149
 150 (make-variable-buffer-local 'whitespace-visual-chars)
 151
 152 (defcustom whitespace-visual-mode-hook nil
 153   "*Run after the `whitespace-visual-mode' is switched on."
 154   :type 'hook
 155   :group 'whitespace-visual)
 156
 157 (defcustom whitespace-visual-incremental-mode-hook nil
 158   "*Run after the `whitespace-visual-incremental-mode' is switched on."
 159   :type 'hook
 160   :group 'whitespace-visual)
 161
 162 ;; We don't need adapt.
 163 ;; (if (adapt-xemacsp)
 164 ;; (progn
 165
 166 (defcustom whitespace-visual-install-toolbar-icon nil
 167   "Set it to t, if a toolbar icon should be installed during loading this file.
 168 The icon calls the function 'whitespace-visual-toolbar-function'."
 169   :type 'boolean
 170   :group 'whitespace-visual)
 171
 172 (defcustom whitespace-visual-install-submenu nil
 173   "Set it to t, if a submenu should be installed during loading this file."
 174   :type 'boolean
 175   :group 'whitespace-visual)
 176
 177 ;; ))
 178
 179
 180 (defcustom whitespace-visual-toolbar-function
 181   'whitespace-visual-incremental-mode
 182   "*The toolbar icon for the whitespace visual mode calls this function.
 183 Valid values are:
 184  'whitespace-visual--mode and 'whitespace-visual-incremental-mode."
 185   :type 'function
 186   :group 'whitespace-visual)
 187
 188 (defcustom whitespace-visual-blank-and-tab-search-string "\\( \\)\\|\\(\t\\)"
 189   "The regexp used to search for tabs and blanks."
 190   :type 'regexp
 191   :group 'whitespace-visual)
 192
 193 (defcustom whitespace-visual-tab-search-string "\t"
 194   "The search string used to find tabs."
 195   :type 'string
 196   :group 'whitespace-visual)
 197
 198 (defcustom whitespace-visual-blank-search-string " "
 199   "The search string used to find blanks."
 200   :type 'string
 201   :group 'whitespace-visual)
 202
 203 (defface whitespace-visual-blank-face
 204   '((t
 205      (:background "LightBlue1")))
 206   "Face to show blanks with"
 207   :group 'whitespace-visual)
 208
 209 (defface whitespace-visual-tab-face
 210   '((t
 211      (:background "yellow" :underline t)))
 212   "Face to show TABs with"
 213   :group 'whitespace-visual)
 214
 215 (defun whitespace-visual-show-faces ()
 216   "Shows the faces used by the `whitespace-visual-mode'."
 217   (interactive)
 218   (save-excursion
 219     (let ((actual-buffer-name (buffer-name (current-buffer)))
 220           (actual-whitespace-chars whitespace-visual-chars)
 221           (whitespace-visual-mode-active
 222            (or whitespace-visual-mode
 223                whitespace-visual-incremental-mode))
 224           (buffer (get-buffer-create "*Help*")))
 225       (set-buffer buffer)
 226       (setq whitespace-visual-chars actual-whitespace-chars)
 227       (delete-region (point-min) (point-max))
 228       (insert "In the whitespace visual minor mode\n"
 229               " this \" ")
 230       (whitespace-visual-highlight-region (1- (point)) (point))
 231       (insert "\" is a blank, highlighted with "
 232               "`whitespace-visual-blank-face' and\n"
 233               " this \"\t")
 234       (whitespace-visual-highlight-region (1- (point)) (point))
 235       (insert "\" is a tab,  highlighted with `whitespace-visual-tab-face'.")
 236
 237       (newline 2)
 238       (if (eq whitespace-visual-chars 'blanks)
 239           (insert
 240            "The highlighting of tabs is switched off.\n")
 241         (if (eq whitespace-visual-chars 'tabs)
 242             (insert
 243              "The highlighting of blanks is switched off.\n")))
 244       (newline)
 245       (if whitespace-visual-mode-active
 246           (insert "A whitespace-visual minor mode is active in the buffer\n  "
 247                   actual-buffer-name
 248                   ".\n")
 249         (insert "No whitespace-visual minor mode is active in the buffer\n  "
 250                 actual-buffer-name
 251                 ".\n"))
 252       (show-temp-buffer-in-current-frame buffer)
 253       )))
 254
 255 ;;;
 256 (defun whitespace-visual-highlight-chars-in-region (char-string from to face)
 257   "Highlights the CHAR-STRING in the region from FROM to TO with the FACE."
 258   (while (search-forward char-string end t)
 259     (let ((extent))
 260       (cond ((match-beginning 0)
 261              (setq extent (make-extent (match-beginning 0) (match-end 0)))
 262              (set-extent-face extent face)
 263              ))
 264       (set-extent-property extent 'start-open t)
 265       (set-extent-property extent 'end-open t)
 266       )))
 267
 268 (defun whitespace-visual-highlight-region (from to)
 269   "Highlights the whitespaces in the region from FROM to TO."
 270   (let ((start (min from to))
 271         (end (max from to)))
 272     (save-excursion
 273       ;;    (message "Highlighting tabs and blanks...")
 274       (goto-char start)
 275       (cond ((eq whitespace-visual-chars 'tabs-and-blanks)
 276              (while (search-forward-regexp
 277                      whitespace-visual-blank-and-tab-search-string end t)
 278                (let ((extent))
 279                  (cond ((match-beginning 1) ; blanks ?
 280                         (setq extent (make-extent (match-beginning 1)
 281                                                   (match-end 1)))
 282                         (set-extent-face extent 'whitespace-visual-blank-face)
 283                         )
 284                        ((match-beginning 2) ; tabs ?
 285                         (setq extent (make-extent (match-beginning 2)
 286                                                   (match-end 2)))
 287                         (set-extent-face extent 'whitespace-visual-tab-face)
 288                         )
 289                        )
 290                  (set-extent-property extent 'start-open t)
 291                  (set-extent-property extent 'end-open t)
 292                  )))
 293             ((eq whitespace-visual-chars 'tabs)
 294              (whitespace-visual-highlight-chars-in-region
 295               whitespace-visual-tab-search-string
 296               from
 297               to
 298               'whitespace-visual-tab-face))
 299             ((eq whitespace-visual-chars 'blanks)
 300              (whitespace-visual-highlight-chars-in-region
 301               whitespace-visual-blank-search-string
 302               from
 303               to
 304               'whitespace-visual-blank-face))
 305             (t (error "ERROR: Bad value of whitespace-visual-highlight-char")))
 306       )))
 307
 308 (defun whitespace-visual-highlight-buffer ()
 309   "Highlights the whitespaces in the current buffer."
 310   (whitespace-visual-highlight-region (point-min) (point-max))
 311 )
 312
 313 (defsubst whitespace-visual-find-next-highlighted-region (from to)
 314   "Returns nil or the next highlighted region."
 315   (map-extents '(lambda (extent dummy)
 316                  (if (extent-property extent
 317                                       'whitespace-visual-highlighted-region)
 318                      extent))
 319                nil
 320                from
 321                to))
 322
 323 (defun whitespace-visual-incremental-highlight (from to)
 324   "Highlights the region from FROM to TO incremental."
 325   (save-excursion
 326     (goto-char from)
 327     (let ((extent (extent-at (point) nil 'whitespace-visual-highlighted-region))
 328           (next-extent nil)
 329           (start nil))
 330       (while (< (point) to)
 331         (if extent
 332             (goto-char (extent-end-position extent)))
 333         (if (< (point) to)
 334             (progn
 335               (setq start (point))
 336
 337               (setq next-extent (whitespace-visual-find-next-highlighted-region
 338                                  start
 339                                  to))
 340               (if extent
 341                   (if next-extent
 342                       (progn
 343                         (set-extent-endpoints extent
 344                                               (extent-start-position extent)
 345                                               (extent-end-position next-extent)
 346                                               )
 347                         (whitespace-visual-highlight-region start
 348                                                      (1-
 349                                                       (extent-start-position
 350                                                        next-extent)))
 351                         (delete-extent next-extent))
 352                     (set-extent-endpoints extent
 353                                           (extent-start-position extent)
 354                                           to)
 355                     (whitespace-visual-highlight-region start to))
 356                 (if next-extent
 357                     (progn
 358                       (setq extent next-extent)
 359                       (whitespace-visual-highlight-region
 360                        start
 361                        (1- (extent-start-position
 362                             next-extent)))
 363                       (set-extent-endpoints extent
 364                                             start
 365                                             (extent-end-position next-extent)))
 366                   (setq extent (make-extent start to))
 367                   (set-extent-property extent
 368                                        'whitespace-visual-highlighted-region t)
 369                   (whitespace-visual-highlight-region start to)))
 370               ))))))
 371
 372
 373 (defun whitespace-visual-highlight-window ()
 374   "Highlights the whitespaces in the current window."
 375   (whitespace-visual-incremental-highlight
 376    (save-excursion
 377      (forward-line (- (window-height)))
 378      (point))
 379    (save-excursion
 380      (forward-line (window-height))
 381      (point))))
 382
 383 (defun whitespace-visual-dehighlight-region (start end)
 384   "Dehighlights the whitespaces in the region from START to END."
 385   (map-extents '(lambda (extent dummy)
 386                   (if (or (eq (extent-face extent)
 387                               'whitespace-visual-blank-face)
 388                           (eq (extent-face extent)
 389                               'whitespace-visual-tab-face)
 390                           (extent-property
 391                            extent
 392                            'whitespace-visual-highlighted-region))
 393                       (progn
 394                         (delete-extent extent)
 395                         nil)))
 396                nil
 397                start
 398                end
 399                )
 400   )
 401
 402 (defun whitespace-visual-dehighlight-buffer ()
 403   "Dehighlights the whitespaces in the current buffer."
 404   (whitespace-visual-dehighlight-region (point-min) (point-max))
 405   )
 406
 407 (defun whitespace-visual-highlight-after-change-function (beg end len)
 408   "Called, when any modification is made to buffer text.  Highlights
 409 the whitespaces (blanks and tabs) in the region from BEG to
 410 END. LEN isn't used, but provided from the after-change hook."
 411   (if (or (eq beg end)
 412           (null whitespace-visual-mode))
 413       nil
 414     (whitespace-visual-dehighlight-region beg end)
 415     (whitespace-visual-highlight-region beg end)))
 416
 417 ;;;###autoload
 418 (defun whitespace-visual-mode (&optional arg)
 419   "Toggle whitespace visual mode.
 420 With arg, turn whitespace visual mode on iff arg is positive.
 421 In whitespace visual mode the different whitespaces (tab and blank)
 422 are highlighted with different faces. The faces are:
 423 `whitespace-visual-blank-face' and `whitespace-visual-tab-face'.
 424 Use the command `whitespace-visual-show-faces' to show their values."
 425   (interactive "P")
 426   (setq whitespace-visual-mode
 427         (if (null arg) (not whitespace-visual-mode)
 428           (> (prefix-numeric-value arg) 0)))
 429   (if (and whitespace-visual-mode whitespace-visual-incremental-mode)
 430       (progn
 431         (whitespace-visual-incremental-highlight (point-min) (point-max))
 432         (setq whitespace-visual-incremental-mode nil)
 433         (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
 434         (run-hooks 'whitespace-visual-mode-hook)
 435         )
 436     (setq whitespace-visual-incremental-mode nil)
 437     (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
 438     (redraw-modeline) ;(force-mode-line-update)
 439     (if whitespace-visual-mode
 440         (progn
 441           (whitespace-visual-highlight-buffer)
 442           (make-local-variable 'after-change-functions)
 443           (add-hook 'after-change-functions
 444                     'whitespace-visual-highlight-after-change-function)
 445           (run-hooks 'whitespace-visual-mode-hook))
 446       (whitespace-visual-dehighlight-buffer)
 447       (remove-hook 'after-change-functions
 448                    'whitespace-visual-highlight-after-change-function)
 449       (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
 450       )))
 451
 452 (defvar whitespace-visual-incremental-mode nil
 453   "Non-nil, if the `whitespace-visual-incremental-mode' is active.")
 454
 455 (make-variable-buffer-local 'whitespace-visual-incremental-mode)
 456
 457 ;;;###autoload
 458 (defun whitespace-visual-incremental-mode (&optional arg)
 459   "Toggle whitespace visual incremental mode.
 460 With arg, turn whitespace-visual incremental mode on iff arg is positive.
 461 In whitespace visual incremental mode the different whitespaces (tab and
 462 blank) are highlighted with different faces. The faces are:
 463 `whitespace-visual-blank-face' and `whitespace-visual-tab-face'.
 464 Use the command `whitespace-visual-show-faces' to show their values.
 465 In this mode only these tabs and blanks are highlighted, which are in
 466 the region from (point) - (window-height) to (point) + (window-height)."
 467   (interactive "P")
 468   (setq whitespace-visual-incremental-mode
 469         (if (null arg) (not whitespace-visual-incremental-mode)
 470           (> (prefix-numeric-value arg) 0)))
 471   (if (and whitespace-visual-mode whitespace-visual-incremental-mode)
 472         (set-extent-property (make-extent (point-min) (point-max))
 473                              'whitespace-visual-highlighted-region
 474                              t))
 475   (setq whitespace-visual-mode nil)
 476   (redraw-modeline) ;(force-mode-line-update)
 477   ;(set-buffer-modified-p (buffer-modified-p)) ;No-op, but updates mode line.
 478   (if whitespace-visual-incremental-mode
 479       (progn
 480         (whitespace-visual-highlight-window)
 481         (make-local-variable 'post-command-hook)
 482         (add-hook 'post-command-hook 'whitespace-visual-highlight-window)
 483         (make-local-variable 'after-change-functions)
 484         (add-hook 'after-change-functions
 485                   'whitespace-visual-highlight-after-change-function)
 486         (run-hooks 'whitespace-visual-incremental-mode-hook))
 487     (whitespace-visual-dehighlight-buffer)
 488     (remove-hook 'after-change-functions
 489                  'whitespace-visual-highlight-after-change-function)
 490     (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
 491     ))
 492
 493
 494 ;;; Add whitespace-visual-mode and whitespace-visual-incremental-mode
 495 ;;; to the minor-mode-alist
 496
 497 ;;;###autoload
 498 (if (fboundp 'add-minor-mode)
 499     (progn
 500       (add-minor-mode 'whitespace-visual-mode
 501                       whitespace-visual-mode-line-string)
 502       (add-minor-mode 'whitespace-visual-incremental-mode
 503                       whitespace-visual-incremental-mode-line-string))
 504   (or (assq 'whitespace-visual-mode minor-mode-alist)
 505       (setq minor-mode-alist
 506             (cons '(whitespace-visual-mode whitespace-visual-mode-line-string)
 507                   minor-mode-alist)))
 508   (or (assq 'whitespace-visual-incremental-mode minor-mode-alist)
 509       (setq minor-mode-alist
 510             (cons '(whitespace-visual-incremental-mode
 511                     whitespace-visual-incremental-mode-line-string)
 512                   minor-mode-alist))))
 513
 514 ;;; Menu for the whitespace-visual mode
 515
 516 (defun whitespace-visual-set-whitespace-chars (new-whitespace-chars)
 517   "Sets the variable `whitespace-visual-chars' and activates the change."
 518   (interactive
 519    (list
 520     (read
 521      (completing-read "Whitespaces to highlight: "
 522                       '(("tabs-and-blanks")
 523                         ("tabs")
 524                         ("blanks"))
 525                       nil
 526                       t
 527                       (symbol-name 'whitespace-visual-chars)))))
 528   (if (eq whitespace-visual-chars new-whitespace-chars)
 529       nil ; nothing to do
 530     (setq whitespace-visual-chars new-whitespace-chars)
 531     (setq-default whitespace-visual-chars new-whitespace-chars)
 532     (cond (whitespace-visual-mode (whitespace-visual-mode)
 533                                   (whitespace-visual-mode))
 534           (whitespace-visual-incremental-mode
 535            (whitespace-visual-incremental-mode)
 536            (whitespace-visual-incremental-mode))
 537           )))
 538
 539 (defvar whitespace-visual-menu nil
 540   "A menu for the whitespace visual minor mode.")
 541
 542 (setq whitespace-visual-menu
 543       '("Whitespace Menu"
 544         ["Highlight Whitespaces"
 545          whitespace-visual-mode
 546          :style toggle
 547          :selected whitespace-visual-mode]
 548         ["Incremental Highlighting"
 549          whitespace-visual-incremental-mode
 550          :style toggle
 551          :selected whitespace-visual-incremental-mode
 552          ]
 553         "---"
 554         ["Show Whitespace Faces" whitespace-visual-show-faces t]
 555         "---"
 556         ["Highlight Tabs & Blanks"
 557          (whitespace-visual-set-whitespace-chars 'tabs-and-blanks)
 558          :style radio
 559          :selected (eq whitespace-visual-chars 'tabs-and-blanks)]
 560         ["Highlight Only Tabs"
 561          (whitespace-visual-set-whitespace-chars 'tabs)
 562          :style radio
 563          :selected (eq whitespace-visual-chars 'tabs)]
 564         ["Highlight Only Blanks"
 565          (whitespace-visual-set-whitespace-chars 'blanks)
 566          :style radio
 567          :selected (eq whitespace-visual-chars 'blanks)]
 568         ))
 569
 570 (if (and (boundp 'whitespace-visual-install-submenu)
 571          whitespace-visual-install-submenu)
 572     (add-submenu '("Tools") whitespace-visual-menu))
 573
 574 ;;; Toolbar icon for the XEmacs
 575
 576 (if (featurep 'toolbar)
 577
 578 (defvar toolbar-wspace-icon
 579   (toolbar-make-button-list
 580    "/* XPM */
 581 static char * whitespace[] = {
 582 \"28 28 4 1\",
 583 \"      c Gray75 s backgroundToolBarColor\",
 584 \".     c black s foregroundToolBarColor\",
 585 \"X     c Gray60\",
 586 \"o     c white\",
 587 \"                            \",
 588 \"                            \",
 589 \"                            \",
 590 \"                            \",
 591 \"         ..      .          \",
 592 \"       XXX.XXXXXX   .       \",
 593 \"       Xoo.oooooXX  .       \",
 594 \" .. .. ..o.o..oo..X...  ..  \",
 595 \"  .  . X.o..o.ooX. X.  .  . \",
 596 \"  .  . .oo.oo.ooX.XX.  .... \",
 597 \"   ... .oo.oo.ooo.oo.  .    \",
 598 \"   .  .Xoo.oo.ooo.oo.  .  . \",
 599 \"   .  .Xo...o..o...o..  ..  \",
 600 \"       XooooooooooooX       \",
 601 \"       XooooooooooooX       \",
 602 \" .... ....ooo...ooo...  ..  \",
 603 \" .  .  .oo.o.oo.oo.oX. .  . \",
 604 \"  .    .oo.ooo..oo.oX  .... \",
 605 \"   ..  .oo.o..o.oo.oX  .    \",
 606 \" .  .  .oo.o.oo.oo.oX. .  . \",
 607 \" ....  ...oo.....oo..   ..  \",
 608 \"       .ooooooooooooX       \",
 609 \"       .XXXXXXXXXXXXX       \",
 610 \"       .                    \",
 611 \"      ...                   \",
 612 \"                            \",
 613 \"                            \",
 614 \"                            \"
 615 };")
 616   "A whitespace icon.")
 617 )
 618
 619 (defun whitespace-visual-toolbar-function ()
 620   "Calls the function determined by `whitespace-visual-toolbar-function'."
 621   (interactive)
 622   (call-interactively whitespace-visual-toolbar-function))
 623
 624 (if (and (featurep 'xemacs) ;; (adapt-xemacsp)
 625          whitespace-visual-install-toolbar-icon
 626          (featurep 'toolbar)
 627          (eq (device-type (selected-device)) 'x))
 628     (let ((tb (mapcar #'(lambda (e)
 629                           (elt e 1)) (specifier-instance default-toolbar))))
 630       (and (not (member 'whitespace-visual-toolbar-function tb))
 631            (set-specifier
 632             default-toolbar
 633             (toolbar-add-item
 634              (make-toolbar-instantiator default-toolbar)
 635              [toolbar-wspace-icon whitespace-visual-toolbar-function
 636                                   t "Toggle whitespace visual mode"]
 637              (let ((n (or
 638                        (position 'toolbar-replace tb)
 639                        (position 'toolbar-undo tb)
 640                        (position 'toolbar-paste tb)
 641                        (position 'toolbar-copy tb)
 642                        (position 'toolbar-cut tb))))
 643                (if n (1+ n) (length tb))))))))
 644
 645 ;;; whitespace-visual-mode.el ends here