--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/utils/xbm-button.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,322 @@
+;;; Create XBM text buttons under XEmacs (requires 19.12 or beyond)
+;;; Copyright (C) 1995 Kyle E. Jones
+;;;
+;;; 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 1, 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.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;;; 02139, USA.
+;;;
+;;; Synched up with: Not in FSF.
+;;;
+;;; Send bug reports to kyle@wonderworks.com
+
+;;; The sole interface function is xbm-button-create.
+
+
+(provide 'xbm-button)
+
+(defvar xbm-button-version "1.00"
+  "Version string for xbm-button.")
+
+(defvar xbm-button-vertical-padding 3
+  "Number of pixels between the text and the top/bottom of the button.")
+
+(defvar xbm-button-horizontal-padding 3
+  "Number of pixels between the text and the left/right edges of the button.")
+
+(defvar xbm-button-font-pixel-lines
+  '(
+"000011000001111110000011110101111111000111111110111111110001111010011110011110111100001111011110111101111000001111000111101110000111000111110001111111000011111000011111110000111101011111111011110011101111000111011110111101110111101111011110111011111111000000000111000000000000000001110000000000011100000000011100000001100011011100000011100000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000000000000000000000011000001000111100011110000111000111110001110011111100111100011110001000000001100000111100000010100011110000110001000000010000001110000000100000010100000000000000000000000000000000001111000110111101100000000011010100000000000000000000000100111100100000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"000011000000110011000110001100110001100011000110011000110011000110001100001100011000000110001100010000110000000111000111000111000010001100011000110001100110001100001100011001100011011011011001100001000110000010001100011000100011000100001100010011000111000000000011000000000000000000110000000000110100000000001100000001100011001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000000100100111001100110110011000111000111100010011011111101100110110011010000000001100011000010000010100110111001101111000000010000011001000010101000100010000000000000000000000000000000001100001100001100110000000011010100000000000000000000000101100110110000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"000101100000110011001100000100110000110011000010011000010110000010001100001100011000000110001100100000110000000111000111000111100010011000001100110001101100000110001100011001100001010011001001100001000110000010001100011000100011101000001100010010001110000000000011000000000000000000110000000000110000000110001100000000000000001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000001100110011001100110110011001011000100000110011010001001100010110011011000000001100100111101001111110100100011001010000000111000011010000001110001100011000000000000000000000000000100001100001100001100110000000001010100000000000000000000000101100110010000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"000101100000110011001100000100110000110011001000011001010110000010001100001100011000000110001101000000110000000101101011000101110010011000001100110001101100000110001100011001111000010011001001100001000011000100000110101101000001111000000110100000011100001111000011011000001110000110110000111001111100111100001101100011100111001101110001100111011001100011101100000111000111011000001101100111011001111011111011101110011110111011101111011101110111011110111011111101100110011000000110000011001011000111100110000000011000110100110011011000000001100101001101000101000110100011001010011000101000001100111010101001000001000000000000000000000000000100001100001100001100110011011010000000000000110000110000001100000110011000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"001000110000111110001100000000110000110011111000011111000110000000001111111100011000000110001111100000110000000101101011000100111010011000001100110011001100000110001111100000111110000011000001100001000011000100000110101101000000111000000110100000011000001001100011101110111011011101110011101100110001100110001110110001100011001101100001100011101110110001110110011101110011101110111011100011111010001001100001100110001100010001100110001000110010001100010010011101100110011000001100001100010011000100110111110000011000111100011111000001100101101011011001000101000011110011010100110101101100011110010000100011000001100000000000000001111110000100001100001000001100010011011000000000000011100000011100001000001100001000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"001111110000110001101100000000110000110011001000011001000110001111001100001100011000000110001101110000110000000101101011000100011110011000001100111110001101100110001100110000001111000011000001100001000001101000000110101101000001011100000011000000111000000111100011000110110000011000110011111100110001100110001100110001100011001111000001100011001100110001100110011000110011000110110001100011000011110001100001100110000110100000110111010000011100000110100000111001100110011000011000000011010011000000110110011000110000101110000011000011111101101011011010011111100000111001100101100101000100100111100000000011000001101111110000000000000000111111101100010000001100001000000000000000001110000000000111011000010000001100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"010000011000110001101100000100110000110011000010011000000110000110001100001100011001100110001100110000110000100100110011000100001110011000001100110000001110010110001100110001000011000011000001100001000001101000000011000110000001001110000011000001110001011001100011000110110000011000110011000000110000111100001100110001100011001101100001100011001100110001100110011000110011000110110001100011000001111001100001100110000110100000110111010000011100000110100001110001100110011000100010110011011111101100110110011000110001000110110011000010011000001001101100001010000110101000001001100100000001100011100000000011000001100000000000000001111110000100001100001000001100010000000000000000000011100000011100010000000000000100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"010000011000110001100110001100110001100011000110011000000011000110001100001100011001100110001100111000110001100100110011000100000110001100011000110000000110011100001100011101100011000011000001110011000000110000000011000110000010000110000011000011100011011011100011001110111011011101110011101100110001000000001100110001100011001100110001100011001100110001100110011101110011101110111011100011000010001001100001101110000011000000011001100000100110000011000011100100100100011001111110110011000011001100110110011000110001100110110010000000000001100100000010001010000110101000001001101000000001110011111000000001000001000000000000000000000000000100001100001100001100110011011000000001100000110110110000010000011000000110100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"111000111101111111000011111001111111000111111110111100000001111010011110011110111100111000011110011101111111101110110111101110000010000111110001111000000011111000011110011001011110000111100000111110000000110000000011000110000111001111000111100011111111001101110010111000001110000110111000111001111001111110011110111011110011011110111011110111101110111011110111000111000011011000001101100111100011110000110000110111000011000000011001100001110111000011000011111100011000111101111110011110000111100111100011110000110000111100011100000000000001100011111100001010000011110000010000110000000000111100110000000001100011000000000000000000000000000100001100001100001100110011011000000001100000000110000000010000011000000010100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000100010000000000000000000000000000000001100001100001100110001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000011000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000011100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100000000000111111100000000000000001111000110111101100010000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111110000000000000000110000000000000000000000000000000000000000000000111100000000011110000000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+   )
+  "List of strings representing pixel lines for the button font.")
+
+(defvar xbm-button-font-line-indices
+  '(("A" 0 10)
+    ("B" 11 19)
+    ("C" 20 28)
+    ("D" 29 38)
+    ("E" 39 47)
+    ("F" 48 56)
+    ("G" 57 66)
+    ("H" 67 77)
+    ("I" 78 82)
+    ("J" 83 90)
+    ("K" 91 100)
+    ("L" 101 109)
+    ("M" 110 121)
+    ("N" 122 132)
+    ("O" 133 142)
+    ("P" 143 151)
+    ("Q" 152 162)
+    ("R" 163 172)
+    ("S" 173 180)
+    ("T" 181 189)
+    ("U" 190 199)
+    ("V" 200 210)
+    ("W" 211 224)
+    ("X" 225 234)
+    ("Y" 235 243)
+    ("Z" 244 252)
+    ("a" 253 260)
+    ("b" 261 269)
+    ("c" 270 276)
+    ("d" 277 285)
+    ("e" 286 292)
+    ("f" 293 298)
+    ("g" 299 306)
+    ("h" 307 315)
+    ("i" 316 320)
+    ("j" 321 324)
+    ("k" 325 333)
+    ("l" 334 338)
+    ("m" 339 351)
+    ("n" 352 360)
+    ("o" 361 368)
+    ("p" 369 377)
+    ("q" 378 386)
+    ("r" 387 393)
+    ("s" 394 399)
+    ("t" 400 405)
+    ("u" 406 414)
+    ("v" 415 423)
+    ("w" 424 436)
+    ("x" 437 444)
+    ("y" 445 453)
+    ("z" 454 460)
+    ("0" 461 467)
+    ("1" 468 472)
+    ("2" 473 479)
+    ("3" 480 486)
+    ("4" 487 493)
+    ("5" 494 500)
+    ("6" 501 507)
+    ("7" 508 514)
+    ("8" 515 521)
+    ("9" 522 528)
+    ("`" 529 531)
+    ("~" 532 538)
+    ("!" 539 541)
+    ("@" 542 552)
+    ("#" 553 560)
+    ("$" 561 567)
+    ("%" 568 580)
+    ("^" 581 586)
+    ("&" 587 597)
+    ("*" 598 603)
+    ("(" 604 608)
+    (")" 609 613)
+    ("-" 614 620)
+    ("_" 621 628)
+    ("=" 629 635)
+    ("+" 636 643)
+    ("[" 644 648)
+    ("{" 649 653)
+    ("]" 654 658)
+    ("}" 659 663)
+    (";" 664 666)
+    (":" 667 669)
+    ("'" 670 672)
+    ("\"" 673 676)
+    ("," 677 679)
+    ("<" 680 686)
+    ("." 687 689)
+    (">" 690 696)
+    ("/" 697 700)
+    ("?" 701 707)
+    ("\\" 708 713)
+    ("|" 714 715)
+    (" " 716 719))
+  "Indices into the xbm-button-font-pixel-lines strings for each character.
+Format is
+  (STR START END)
+STR contains the character.
+START is where the character's pixels start in each string of
+   xbm-button-font-pixel-lines (0 is the index of the first pixel).
+END is the index of the position after the last pixel of the character.")
+
+(defun xbm-bit-lines-to-xbm-bits (&optional beg end)
+  "Convert lines of bits to a string of chars containing the bits,
+plus width and height information.  A list of the form
+   (WIDTH HEIGHT STRING)
+is returned.  WIDTH is set to be the length of the first line,
+ignoring the newline.  HEIGHT is the number of lines in the region.
+
+BEG and END specify the region containing the bit lines.  Each
+line should contain only the characters '0' or '1' and be
+terminated by a newline."
+  (or beg (setq beg (point-min)))
+  (or end (setq end (point-max)))
+  (let (octet octet-count bit-count b char width height)
+    (save-excursion
+      (save-excursion
+	(set-buffer (setq b (get-buffer-create
+			     " xbm-button-bit-lines-to-xbm")))
+	(erase-buffer))
+      (goto-char beg)
+      (setq bit-count 0
+	    height 0
+	    width (- (save-excursion (end-of-line) (point)) (point))
+	    octet 0)
+      (while (< (point) end)
+	(setq char (char-after (point)))
+	(cond ((= char ?0)
+	       (setq bit-count (1+ bit-count)))
+	      ((= char ?1)
+	       ;; least significant bit of octet is leftmost pixel.
+	       (setq octet (+ octet (expt 2 bit-count))
+		     bit-count (1+ bit-count)))
+	      ((= char ?\n)
+	       (setq height (1+ height))))
+	;; output octet whenever we have retrived 8 bits or when
+	;; a newline is encountered.
+	(cond ((or (= bit-count 8) (= char ?\n))
+	       (save-excursion
+		 (set-buffer b)
+		 (insert-char octet))
+	       (setq bit-count 0
+		     octet 0)))
+	(forward-char 1))
+      (set-buffer b)
+      ;; otput last octet if any bits collected.
+      (cond ((not (= bit-count 0))
+	     (insert-char octet)))
+
+      (list width height (buffer-substring nil nil b)) )))
+
+;;;###autoload
+(defun xbm-button-create (text border-thickness)
+  "Returns a list of XBM image instantiators for a button displaying TEXT.
+The list is of the form
+   (UP DOWN DISABLED)
+where UP, DOWN, and DISABLED are the up, down and disabled image
+instantiators for the button.
+
+BORDER-THICKNESS specifies how many pixels should be used for the
+borders on the edges of the buttons.  It should be a positive integer,
+or 0 to mean no border."
+  (save-excursion
+    (set-buffer (get-buffer-create " xbm-button-create"))
+    (erase-buffer)
+    ;; create the correct number of lines for the pixels for the
+    ;; characters.
+    (insert-char ?\n (length xbm-button-font-pixel-lines))
+    (let ((i 0)
+	  (str (make-string 1 0))
+	  (lim (length text))
+	  (bg-char ?0)
+	  font-pixel-lines q)
+      ;; loop through text, adding the character pixels
+      (while (< i lim)
+	(aset str 0 (aref text i))
+	(if (null (setq q (assoc str xbm-button-font-line-indices)))
+	    nil ; no pixel data for this character
+	  (goto-char (point-min))
+	  (setq font-pixel-lines xbm-button-font-pixel-lines)
+	  (while font-pixel-lines
+	    (end-of-line)
+	    (if (not (bolp))
+		;; Insert space before some of the characters.
+		;; This isn't really correct for this font
+		;; but doing it right is too hard.
+		;; This isn't TeX after all.
+		(if (memq (aref str 0) '(?, ?. ?\" ?! ?| ?\' ?\`))
+		    (insert-char bg-char 1))
+	      ;; offset the start a bit from the left edge of the button
+	      (insert-char bg-char xbm-button-horizontal-padding))
+	    ;; insert the character pixels.
+	    (insert (substring (car font-pixel-lines) (nth 1 q) (nth 2 q)))
+	    (forward-line)
+	    (setq font-pixel-lines (cdr font-pixel-lines))))
+	(setq i (1+ i)))
+      ;; now offset the text from the right edge of the button.
+      (goto-char (point-min))
+      (while (not (eobp))
+	(end-of-line)
+	(insert-char bg-char xbm-button-horizontal-padding)
+	(forward-line)))
+    (let ((fg-char ?1)
+	  (bg-char ?0)
+	  i len up down disabled)
+      ;; find the length of a pixel line.
+      (goto-char (point-min))
+      (end-of-line)
+      (setq len (- (point) (point-min)))
+      ;; offset text from the top of the button
+      (goto-char (point-min))
+      (setq i xbm-button-vertical-padding)
+      (while (> i 0)
+	(insert-char bg-char len)
+	(insert ?\n)
+	(setq i (1- i)))
+      ;; offset text from the bottom of the button
+      (goto-char (point-max))
+      (setq i xbm-button-vertical-padding)
+      (while (> i 0)
+	(insert-char bg-char len)
+	(insert ?\n)
+	(setq i (1- i)))
+      ;; add borders to the pixel lines
+      (goto-char (point-min))
+      (while (not (eobp))
+	(insert-char fg-char border-thickness)
+	(end-of-line)
+	(insert-char fg-char border-thickness)
+	(forward-line))
+      ;; add top and bottom border lines
+      (setq i border-thickness)
+      (goto-char (point-min))
+      (while (> i 0)
+	(insert-char fg-char (+ len (* 2 border-thickness)))
+	(insert ?\n)
+	(setq i (1- i)))
+      (setq i border-thickness)
+      (goto-char (point-max))
+      (while (> i 0)
+	(insert-char fg-char (+ len (* 2 border-thickness)))
+	(insert ?\n)
+	(setq i (1- i)))
+      ;; convert the pixel lines to octets of xbm bit data
+      (setq up (xbm-bit-lines-to-xbm-bits)
+	    down up)
+      ;; stipple the foreground pixels for the disabled button.
+      (let ((str (make-string 1 0))
+	    (bit 0)
+	    lim line-start)
+	(aset str 0 fg-char)
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (setq lim (save-excursion (end-of-line) (point))
+		line-start (point))
+	  (while (search-forward str lim t)
+	    (if (= (% (- (point) line-start) 2) bit)
+		(subst-char-in-region (1- (point)) (point) fg-char bg-char t)))
+	  (if (zerop bit)
+	      (setq bit 1)
+	    (setq bit 0))
+	  (forward-line)))
+      (setq disabled (xbm-bit-lines-to-xbm-bits))
+
+      (list (vector 'xbm ':data up)
+	    (vector 'xbm ':data down)
+	    (vector 'xbm ':data disabled)) )))