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