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