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

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