cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hui-xe-but.el

   1 ;;; hui-xe-but.el --- XEmacs button highlighting and flashing support.
   2
   3 ;; Copyright (C) 1992-1995, 2009 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: faces, hypermedia
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;   This is truly prototype code.
  30 ;;
  31 ;;   Can't use read-only buttons here because then outline-mode
  32 ;;   becomes unusable.
  33 ;;
  34
  35 ;;; Code:
  36
  37 (or hyperb:xemacs-p
  38     (error "(hui-xe-but.el):  Load only when running XEmacs."))
  39
  40 ;;;
  41 ;;; Other required Elisp libraries
  42 ;;;
  43
  44 (require 'hbut)
  45
  46 ;;; XEmacs 19.12 renamed x-color-display-p to x-display-color-p.
  47 (if (and (fboundp 'x-color-display-p)
  48          (not (fboundp 'x-display-color-p)))
  49     (fset 'x-display-color-p 'x-color-display-p))
  50
  51 (defun hproperty:background ()
  52   "Returns default background color for selected frame."
  53   (face-background (get-face 'default)))
  54
  55 (defun hproperty:foreground ()
  56   "Returns default foreground color for selected frame."
  57   (face-foreground (get-face 'default)))
  58
  59 ;;;
  60 ;;; Public variables
  61 ;;;
  62
  63 (defvar hproperty:but-emphasize-p nil
  64   "*Non-nil means visually emphasize that button under mouse cursor is selectable.")
  65
  66 (defvar hproperty:but-flash-time 1000
  67   "*Machine specific value for empty loop counter, XEmacs button flash delay.")
  68
  69 (defvar hproperty:item-highlight-color (hproperty:foreground)
  70   "Color with which to highlight list/menu selections.
  71 Call (hproperty:set-item-highlight <color>) to change value.")
  72
  73 ;;;
  74 ;;; Public functions
  75 ;;;
  76
  77 (defun hproperty:but-add (start end face)
  78   "Add between START and END a button using FACE in current buffer.
  79 If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that
  80 button is selectable whenever the mouse cursor moves over it."
  81   (let ((but (make-extent start end)))
  82     (set-extent-face but face)
  83     (set-extent-property but 'highlight hproperty:but-emphasize-p)))
  84
  85 (defun hproperty:but-color ()
  86   "Return current color of buffer's buttons."
  87   (if hproperty:color-ptr
  88       (car hproperty:color-ptr)
  89     (hproperty:foreground)))
  90
  91 (defun hproperty:but-clear ()
  92   "Delete all Hyperbole buttons from current buffer."
  93   (interactive)
  94   (map-extents (function (lambda (extent unused-arg)
  95                            (if (eq (extent-face extent) 'hbut)
  96                                (delete-extent extent))))))
  97
  98 (defun hproperty:but-create (&optional start-delim end-delim regexp-match)
  99   "Highlight all hyper-buttons in buffer using XEmacs extents.
 100 Will use optional strings START-DELIM and END-DELIM instead of default values.
 101 If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
 102 expression which matches an entire button string.
 103 If REGEXP-MATCH is non-nil, only buttons matching this argument are
 104 highlighted.
 105
 106 If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that
 107 button is selectable whenever the mouse cursor moves over it."
 108   (interactive)
 109   (hproperty:but-clear)
 110   (hproperty:but-create-all start-delim end-delim regexp-match))
 111
 112 (defun hproperty:but-create-all (&optional start-delim end-delim regexp-match)
 113   "Mark all hyper-buttons in buffer as XEmacs buttons, for later highlighting.
 114 Will use optional strings START-DELIM and END-DELIM instead of default values.
 115 If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
 116 expression which matches an entire button string.
 117 If REGEXP-MATCH is non-nil, only buttons matching this argument are
 118 highlighted."
 119   (ebut:map (function (lambda (lbl start end)
 120                         (hproperty:but-add start end hproperty:but-face)))
 121             start-delim end-delim regexp-match 'include-delims))
 122
 123 (defun hproperty:but-delete (&optional pos)
 124   (let ((extent (extent-at (or pos (point)))))
 125     (if extent (delete-extent extent))))
 126
 127 ;;;
 128 ;;; Private functions
 129 ;;;
 130
 131 (defmacro hproperty:list-cycle (list-ptr list)
 132   "Move LIST-PTR to next element in LIST or when at end to first element."
 133   (` (or (and (, list-ptr)
 134               (setq (, list-ptr) (cdr (, list-ptr))))
 135          (setq (, list-ptr) (, list)))))
 136
 137 ;;;
 138 ;;; Private variables
 139 ;;;
 140
 141 (defconst hproperty:color-list '( "red" "blue" "paleturquoise4" "mediumpurple2"
 142 "lightskyblue3" "springgreen2" "salmon" "yellowgreen" "darkorchid2"
 143 "aquamarine4" "slateblue4" "slateblue1" "olivedrab1" "goldenrod4"
 144 "goldenrod3" "cadetblue2" "burlywood1" "slategrey" "mistyrose"
 145 "limegreen" "lightcyan" "goldenrod" "gainsboro" "skyblue1" "honeydew"
 146 "yellow2" "tomato3" "skyblue" "purple4" "orange3" "bisque3" "bisque2"
 147 "grey34" "gray99" "gray63" "gray44" "gray37" "gray33" "gray26" "azure1"
 148 "snow4" "peru" "red" "lightgoldenrod4" "mediumseagreen" "blush"
 149 "mediumorchid2" "lightskyblue1" "darkslateblue" "midnightblue"
 150 "lightsalmon1" "lemonchiffon" "yellow" "lightsalmon" "coral"
 151 "dodgerblue3" "darkorange4" "blue" "royalblue4" "red" "green" "cyan"
 152 "darkviolet" "darksalmon" "darkorange" "blue" "pink" "magenta2"
 153 "sienna4" "khaki2" "grey75" "grey74" "grey73" "grey69" "grey68" "grey35"
 154 "grey13" "gray90" "gray81" "gray55" "gray51" "gray31" "snow2" "pink3"
 155 "grey7" "gray1" "red4" "red3" "tan" "red" "yellow" "mediumvioletred"
 156 "lightslategrey" "lavenderblush4" "turquoise" "darkturquoise"
 157 "darkslategrey" "lightskyblue" "lightsalmon4" "lightsalmon3"
 158 "forestgreen" "dodgerblue4" "orchid" "rosybrown4" "brown" "peachpuff3"
 159 "palegreen3" "orangered2" "rose" "lightcyan4" "indianred4" "indianred3"
 160 "seagreen2" "indianred" "deeppink1" "navyblue" "lavender" "grey"
 161 "deeppink" "salmon4" "salmon3" "oldlace" "grey78" "grey77" "grey54"
 162 "grey45" "grey21" "gray97" "gray96" "gray95" "gray88" "gray87" "gray86"
 163 "gray70" "gray57" "gray38" "gray12" "gray11" "plum3" "linen" "gray9"
 164 "gray8" "blue4" "beige" "turquoise" "blue" "lemonchiffon4"
 165 "darkseagreen1" "antiquewhite3" "mediumorchid" "springgreen"
 166 "turquoise4" "steelblue3" "mistyrose2" "lightcyan2" "red" "firebrick2"
 167 "royalblue" "cadetblue" "skyblue3" "yellow3" "salmon1" "orange4"
 168 "hotpink" "grey90" "gray56" "gray39" "gray18" "gray14" "plum4" "grey6"
 169 "gray6" "gold3" "gold1" "blue2" "tan2" "cyan" "mediumspringgreen"
 170 "darkolivegreen2" "goldenrod" "lightsteelblue" "brown" "whip"
 171 "chartreuse3" "violetred4" "royalblue2" "royalblue1" "papayawhip"
 172 "mistyrose3" "lightcyan1" "aquamarine" "skyblue4" "hotpink4" "hotpink3"
 173 "hotpink2" "dimgray" "tomato" "grey66" "grey65" "grey64" "grey33"
 174 "grey27" "gray76" "gray69" "gray68" "grey0" "azure" "green"
 175 "darkgoldenrod4" "darkgoldenrod3" "darkgoldenrod2" "darkgoldenrod"
 176 "brown" "lightsalmon2" "deepskyblue4" "deepskyblue3" "deepskyblue2"
 177 "deepskyblue" "darkorange1" "violetred3" "violetred2" "violetred1"
 178 "slateblue3" "slateblue2" "drab" "indianred1" "firebrick1" "cadetblue4"
 179 "violetred" "rosybrown" "blue" "firebrick" "grey100" "wheat4" "grey79"
 180 "grey76" "grey61" "gray93" "gray84" "gray65" "gray36" "gray32" "gray13"
 181 "gray10" "azure3" "snow1" "tan1" "gray" "darkolivegreen1" "blue"
 182 "almond" "lavenderblush3" "lavenderblush2" "lavenderblush1"
 183 "darkolivegreen" "lavenderblush" "aquamarine2" "red" "olivedrab2"
 184 "mistyrose4" "mistyrose1" "lightcyan3" "lightcoral" "chartreuse"
 185 "peachpuff" "palegreen" "mintcream" "skyblue2" "moccasin" "tomato1"
 186 "orchid3" "maroon3" "salmon" "grey81" "grey62" "grey39" "grey38"
 187 "grey37" "gray92" "gray83" "gray66" "gray54" "gray50" "gray30" "gray19"
 188 "gray15" "azure4" "grey3" "tan3" "pink" "gray" "blue" "lightsteelblue2"
 189 "lightsteelblue1" "green" "lightslategray" "lemonchiffon2"
 190 "springgreen1" "greenyellow" "chartreuse2" "grey" "royalblue3"
 191 "powderblue" "peachpuff2" "palegreen2" "cream" "slateblue" "seashell2"
 192 "deeppink2" "darkkhaki" "maroon4" "sienna" "grey71" "grey67" "grey18"
 193 "gray59" "gray43" "gray25" "bisque" "red1" "mediumslateblue"
 194 "lightgoldenrod1" "goldenrod" "paleturquoise3" "lightskyblue4" "green"
 195 "yellow" "smoke" "blue" "white" "steelblue4" "rosybrown3" "peachpuff1"
 196 "palegreen1" "blueviolet" "seashell4" "sienna3" "grey40" "gray91"
 197 "gray82" "gray5" "cyan2" "cyan1" "blue1" "snow" "lightgoldenrod2"
 198 "lightslateblue" "mediumorchid3" "darkseagreen4" "springgreen3" "green"
 199 "slategray4" "slategray3" "slategray2" "blue" "peachpuff4" "palegreen4"
 200 "green" "orangered3" "goldenrod1" "ghostwhite" "firebrick4" "firebrick3"
 201 "cadetblue3" "slategray" "seashell3" "honeydew3" "cornsilk4" "cornsilk2"
 202 "purple1" "dimgrey" "khaki1" "ivory3" "grey70" "grey60" "grey32"
 203 "grey22" "grey12" "gray98" "gray89" "gray71" "gray64" "gray60" "gray49"
 204 "azure2" "gray3" "paleturquoise1" "mediumpurple1" "purple"
 205 "lemonchiffon1" "blue" "navajowhite3" "darkorchid1" "orange"
 206 "goldenrod2" "khaki" "chocolate2" "burlywood2" "honeydew1" "darkgreen"
 207 "thistle3" "thistle2" "thistle1" "thistle" "maroon2" "maroon1" "grey53"
 208 "grey44" "grey25" "gray74" "gray45" "gray41" "gray35" "gray27" "gray23"
 209 "gray16" "brown4" "wheat" "coral" "tan4" "lightgoldenrodyellow" "blue"
 210 "green" "gray" "palevioletred3" "mediumpurple4" "mediumpurple3"
 211 "saddlebrown" "blue" "darkorchid4" "darkorchid3" "puff" "olivedrab4"
 212 "lightblue4" "lightpink" "lightgray" "honeydew2" "cornsilk1" "lace"
 213 "sienna1" "bisque4" "orchid" "khaki3" "grey84" "grey83" "grey82"
 214 "grey72" "grey52" "grey43" "grey26" "grey14" "grey10" "gray75" "gray53"
 215 "gray21" "gray20" "brown3" "grey8" "red2" "navy" "grey" "gold"
 216 "mediumaquamarine" "lightgoldenrod" "darkslategray4" "darkseagreen3"
 217 "darkseagreen2" "antiquewhite4" "white" "springgreen4" "lightyellow4"
 218 "white" "aquamarine1" "turquoise3" "steelblue2" "rosybrown2" "pink"
 219 "gray" "indianred2" "dodgerblue" "green" "seagreen1" "deeppink4"
 220 "aliceblue" "magenta1" "pink" "sienna2" "orchid1" "gray100" "grey97"
 221 "grey94" "grey87" "grey86" "grey51" "grey42" "grey19" "gray94" "gray85"
 222 "gray61" "brown2" "khaki" "grey1" "gold4" "blue" "green" "grey"
 223 "turquoise" "paleturquoise" "mediumorchid4" "antiquewhite2"
 224 "lightyellow2" "violet" "salmon" "chartreuse1" "turquoise1" "sandybrown"
 225 "orangered1" "lightpink1" "lightblue2" "lightblue1" "grey" "seagreen4"
 226 "seagreen3" "lightblue" "deeppink3" "burlywood" "seashell" "hotpink1"
 227 "gray" "yellow4" "yellow" "purple" "orange" "ivory4" "grey99" "grey89"
 228 "grey63" "grey58" "grey49" "grey31" "grey24" "grey20" "green4" "green1"
 229 "gray73" "gray67" "coral3" "coral2" "plum2" "pink4" "ivory" "gray4"
 230 "gray2" "gold2" "aquamarine" "grey" "lightgoldenrod3" "darkolivegreen3"
 231 "darkgoldenrod1" "goldenrod" "orchid" "chiffon" "navajowhite4"
 232 "deepskyblue1" "lightyellow" "floralwhite" "blue" "mediumblue"
 233 "chocolate4" "chocolate3" "burlywood4" "turquoise" "steelblue" "green"
 234 "lawngreen" "honeydew4" "seagreen" "orchid4" "wheat1" "violet" "ivory1"
 235 "grey88" "grey85" "grey57" "grey56" "grey55" "grey48" "grey47" "grey46"
 236 "grey30" "grey17" "gray47" "gray29" "pink2" "grey5" "grey4" "green"
 237 "gray0" "brown" "lightsteelblue4" "darkolivegreen4" "palevioletred4"
 238 "blue" "darkslategray3" "darkslategray2" "darkslategray1"
 239 "blanchedalmond" "palegoldenrod" "blue" "lightseagreen" "lemonchiffon3"
 240 "darkslategray" "green" "darkseagreen" "antiquewhite" "darkorange2"
 241 "chartreuse4" "blue" "rosybrown1" "olivedrab3" "lightpink2" "orangered"
 242 "thistle4" "blue" "cornsilk" "salmon2" "orchid2" "ivory2" "grey93"
 243 "grey92" "grey91" "grey36" "grey29" "grey28" "grey16" "gray79" "gray78"
 244 "gray77" "gray48" "gray17" "coral4" "coral1" "plum1" "pink1" "grey9"
 245 "grey2" "gray7" "cyan4" "blue3" "plum" "cornflowerblue" "lightskyblue2"
 246 "antiquewhite1" "navajowhite2" "navajowhite1" "lightyellow3"
 247 "navajowhite" "darkorange3" "whitesmoke" "turquoise2" "steelblue1"
 248 "lightpink4" "lightblue3" "green" "chocolate1" "blue" "olivedrab"
 249 "lightgrey" "chocolate" "magenta4" "magenta3" "yellow1" "purple3"
 250 "purple2" "orange2" "orange1" "magenta" "bisque1" "wheat2" "maroon"
 251 "khaki4" "grey96" "grey95" "grey80" "grey50" "grey41" "grey15" "grey11"
 252 "gray80" "gray58" "gray40" "gray34" "gray22" "brown1" "snow3"
 253 "mediumturquoise" "lightsteelblue3" "palevioletred2" "palevioletred1"
 254 "paleturquoise2" "green" "palevioletred" "mediumorchid1" "white"
 255 "mediumpurple" "lightyellow1" "dodgerblue2" "dodgerblue1" "violet"
 256 "aquamarine3" "slategray1" "gray" "orangered4" "lightpink3" "blue"
 257 "darkorchid" "cadetblue1" "burlywood3" "seashell1" "cornsilk3" "tomato4"
 258 "tomato2" "wheat3" "grey98" "grey59" "grey23" "green3" "green2" "gray72"
 259 "gray62" "gray52" "gray46" "gray42" "gray28" "gray24" "white" "cyan3"
 260 "black" ))
 261
 262 (defvar hproperty:color-ptr nil
 263   "Pointer to current color name table to use for Hyperbole buttons in XEmacs.")
 264
 265 (defconst hproperty:good-colors
 266   '(
 267     "medium violet red" "indianred4" "firebrick1" "DarkGoldenrod" "NavyBlue"
 268     "darkorchid" "tomato3" "mediumseagreen" "deeppink" "forestgreen"
 269     "mistyrose4" "slategrey" "purple4" "dodgerblue3" "mediumvioletred"
 270     "lightsalmon3" "orangered2" "turquoise4" "Gray55"
 271     )
 272   "Good colors for contrast against wheat background and black foreground.")
 273
 274
 275 ;;;
 276 ;;; Public functions
 277 ;;;
 278
 279 (defun hproperty:cycle-but-color (&optional color)
 280   "Switches button color to optional COLOR name or next item referenced by hproperty:color-ptr."
 281   (interactive "sHyperbole button color: ")
 282   (if (not (x-display-color-p))
 283       nil
 284     (if color (setq hproperty:color-ptr nil))
 285     (set-face-foreground
 286      hproperty:but-face
 287      (or color (car (hproperty:list-cycle
 288                      hproperty:color-ptr hproperty:good-colors))))
 289     (hproperty:set-flash-color)
 290     (sit-for 0)  ;; Force display update
 291     t))
 292
 293 (defun hproperty:set-flash-color ()
 294   "Set button flashing colors based upon current color set."
 295   (if (not (x-display-color-p))
 296       nil
 297     (set-face-background hproperty:flash-face (hproperty:but-color))
 298     (set-face-foreground hproperty:flash-face (hproperty:background))))
 299
 300 (defun hproperty:but-flash ()
 301   "Flash a XEmacs Hyperbole button at or near point to indicate selection."
 302   (interactive)
 303   (let ((ibut) (prev)
 304         (start (hattr:get 'hbut:current 'lbl-start))
 305         (end   (hattr:get 'hbut:current 'lbl-end))
 306         (b) (a))
 307     (if (and start end (setq prev (extent-at start)
 308                              ibut t))
 309         (progn (if (not prev) (hproperty:but-add start end hproperty:but-face))
 310                (setq b (and start (extent-at start))))
 311       (setq b (extent-at (point))))
 312     (if (setq a (and (extentp b) (extent-face b)))
 313         (progn
 314           (set-extent-face b hproperty:flash-face)
 315           (sit-for 0);; Force display update
 316           ;; Delay before redraw button
 317           (let ((i 0)) (while (< i hproperty:but-flash-time) (setq i (1+ i))))
 318           (set-extent-face b a)
 319           (sit-for 0);; Force display update
 320           ))
 321     (if (and ibut (not prev)) (hproperty:but-delete start))
 322     ))
 323
 324 (defun hproperty:set-item-highlight (&optional background foreground)
 325   "Setup or reset item highlight face using optional BACKGROUND and FOREGROUND."
 326   (make-local-variable 'hproperty:item-face)
 327   (if background (setq hproperty:item-highlight-color background))
 328   (if (not hproperty:highlight-face)
 329       (progn
 330         (setq hproperty:highlight-face
 331               (or (find-face 'hproperty:highlight-face)
 332                   (face-name (make-face 'hproperty:highlight-face))))
 333         (set-face-foreground hproperty:highlight-face
 334                              (or foreground (hproperty:background)))
 335         (set-face-underline-p hproperty:highlight-face nil)))
 336
 337   (let* ((tty (and (fboundp 'device-type)
 338                    (eq 'tty (device-type (selected-device)))))
 339          (specifiers-function
 340           (if (fboundp 'specifier-specs) 'specifier-specs 'identity))
 341          (color-function
 342           (if (fboundp 'color-name) 'color-name 'identity))
 343          (update-rolo-highlight-flag
 344           (and (boundp 'rolo-highlight-face) (find-face rolo-highlight-face)
 345                (or (null
 346                     (funcall specifiers-function
 347                              (face-foreground rolo-highlight-face)))
 348                    (equal
 349                     (funcall color-function
 350                              (face-foreground rolo-highlight-face))
 351                     (funcall color-function (face-foreground 'default)))
 352                    (face-equal hproperty:highlight-face rolo-highlight-face)))))
 353     (if tty
 354         (copy-face 'italic 'hproperty:highlight-face)
 355       (if (and (funcall specifiers-function
 356                         (face-background hproperty:highlight-face))
 357                (equal (funcall color-function
 358                                (face-background hproperty:highlight-face))
 359                       hproperty:item-highlight-color))
 360           nil
 361         (set-face-background hproperty:highlight-face
 362                              hproperty:item-highlight-color))
 363       (and background (not (equal (face-background
 364                                    hproperty:highlight-face) background))
 365            (set-face-background hproperty:highlight-face background))
 366       (and foreground (not (equal (face-foreground
 367                                    hproperty:highlight-face) foreground))
 368            (set-face-foreground hproperty:highlight-face foreground)))
 369     (setq hproperty:item-face hproperty:highlight-face)
 370     (if update-rolo-highlight-flag
 371         (if tty
 372             (copy-face 'italic 'rolo-highlight-face)
 373           (copy-face hproperty:highlight-face rolo-highlight-face)))))
 374
 375 (defun hproperty:select-item (&optional pnt)
 376   "Select item in current buffer at optional position PNT using hproperty:item-face."
 377   (if hproperty:item-button
 378       nil
 379     (set-extent-face (setq hproperty:item-button (make-extent (point) (point)))
 380                      hproperty:item-face))
 381   (if pnt (goto-char pnt))
 382   (skip-chars-forward " \t")
 383   (skip-chars-backward "^ \t\n")
 384   (let ((start (point)))
 385     (save-excursion
 386       (skip-chars-forward "^ \t\n")
 387       (set-extent-endpoints hproperty:item-button start (point))
 388       ))
 389   (sit-for 0)  ;; Force display update
 390   )
 391
 392 (defun hproperty:select-line (&optional pnt)
 393   "Select line in current buffer at optional position PNT using hproperty:item-face."
 394   (if hproperty:item-button
 395       nil
 396     (set-extent-face (setq hproperty:item-button (make-extent (point) (point)))
 397                      hproperty:item-face))
 398   (if pnt (goto-char pnt))
 399   (save-excursion
 400     (beginning-of-line)
 401     (set-extent-endpoints hproperty:item-button (point) (progn (end-of-line) (point)))
 402     )
 403   (sit-for 0)  ;; Force display update
 404   )
 405
 406 ;;;
 407 ;;; Private variables
 408 ;;;
 409
 410 (defvar hproperty:but-face (face-name (make-face 'hproperty:but-face))
 411   "Face for hyper-buttons.")
 412 (setq hproperty:but hproperty:but-face)
 413
 414 ;;; Init file may set properties so set this after init file has been
 415 ;;; loaded.
 416 (defun hproperty:set-face-after-init ()
 417   "Set foreground and background color on button face"
 418   (if (and (fboundp 'device-type)
 419            (eq 'tty (device-type (selected-device))))
 420       (copy-face 'italic 'hproperty:but-face)
 421     (set-face-foreground hproperty:but-face (hproperty:but-color))
 422     (set-face-background hproperty:but-face (hproperty:background))))
 423 (add-hook 'after-init-hook 'hproperty:set-face-after-init)
 424
 425 (defvar hproperty:flash-face (face-name (make-face 'hproperty:flash-face))
 426   "Face for flashing hyper-buttons.")
 427 (hproperty:set-flash-color)
 428
 429 (defvar hproperty:item-button nil
 430   "Button used to highlight an item in a listing buffer.")
 431 (make-variable-buffer-local 'hproperty:item-button)
 432 (defvar hproperty:item-face nil "Item marking face.")
 433 (defvar hproperty:highlight-face nil
 434   "Item highlighting face.  Use (hproperty:set-item-highlight) to set.")
 435 (if hproperty:highlight-face
 436     nil
 437   ;; Reverse foreground and background colors for default block-style highlighting.
 438   (hproperty:set-item-highlight (hproperty:foreground) (hproperty:background)))
 439
 440 (provide 'hui-xe-but)
 441
 442 ;;; hui-xe-but.el ends here