home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / alt / lucidem / help / 126 < prev    next >
Encoding:
Text File  |  1992-07-25  |  24.3 KB  |  591 lines
  1. Newsgroups: alt.lucid-emacs.help
  2. Sender: help-lucid-emacs-request@lucid.com
  3. Message-ID: <9207241926.AA02186@gateway.bnr.ca>
  4. Date:       24 Jul 92 15:24:00 EDT
  5. From: Jeffrey (J.D.) Sparkes <JSPARKES%BNR.CA@lucid.com>
  6. Subject:    patches for Hyperbole to run on lemacs19.2
  7. Path: sparky!uunet!wendy-fate.uu.net!help-lucid-emacs
  8. Lines: 581
  9.  
  10. Hi, I've made Hyperbole work under Lucid emacs 19.2, and I'd like some
  11. brave beta testers. :-).  Actually, everything seems to work fine,
  12. with just one problem:
  13.  
  14. KNOWN BUG/PROBLEMS
  15.  
  16. 1. sm-mouse-toggle-bindings (commonly bound to C-ct) does not preserve
  17.    mode specific bindings because it only records the "default"
  18.    bindings once.  Any advice on what to do for this is welcome.  (I
  19.    find it annoying that I can't use the popup menu in Info-mode.)
  20.  
  21.  
  22. Anyway, please try these patches and let me know if you have any problems.
  23.  
  24. *** 1.1    1992/07/15 20:51:21
  25. --- hinit.el    1992/07/24 14:32:54
  26. ***************
  27. *** 38,44 ****
  28.   ;;; Public variables
  29.   ;;; ************************************************************************
  30.  
  31. ! (defconst hyperb:version "3.04" "Hyperbole revision number.")
  32.  
  33.   (defvar   hyperb:host-domain nil
  34.     "<@domain-name> for current host.  Set automatically by 'hyperb:init'.")
  35. --- 38,44 ----
  36.   ;;; Public variables
  37.   ;;; ************************************************************************
  38.  
  39. ! (defconst hyperb:version "3.04+Lucid" "Hyperbole revision number.")
  40.  
  41.   (defvar   hyperb:host-domain nil
  42.     "<@domain-name> for current host.  Set automatically by 'hyperb:init'.")
  43. ***************
  44. *** 107,112 ****
  45. --- 107,113 ----
  46.     ;; Highlight explicit buttons whenever a file is read in.
  47.     ;;
  48.     (if hyperb:epoch-p (var:append 'find-file-hooks '(ep:but-create)))
  49. +   (if hyperb:lucid-p (var:append 'find-file-hooks '(le:but-create)))
  50.     ;;
  51.     ;; Save button attribute file whenever same dir file is saved and
  52.     ;; 'ebut:hattr-save' is non-nil.
  53. *** 1.1    1992/07/14 17:24:04
  54. --- hmouse-key.el    1992/07/24 14:34:12
  55. ***************
  56. *** 88,93 ****
  57. --- 88,98 ----
  58.               (mouse::index mouse-right mouse-up)))
  59.       (let ((wsys (sm-window-sys-term)))
  60.         (cond
  61. +        ;; Lucid emacs 19
  62. +        ((string-match "Lucid" (emacs-version))
  63. +     (mapcar '(lambda (key) (cons key (key-binding key)))
  64. +         (list 'button2 'button2up 'button3 'button3up)))
  65. +
  66.          ;; X
  67.          ((equal wsys "xterm")
  68.       (mapcar '(lambda (key) (cons key (lookup-key mouse-map key)))
  69. ***************
  70. *** 120,125 ****
  71. --- 125,135 ----
  72.       (let ((wsys (sm-window-sys-term)))
  73.         (cond
  74.          ;; X
  75. +        ((string-match "Lucid" (emacs-version))
  76. +     (mapcar
  77. +      '(lambda (key-and-binding)
  78. +         (global-set-key (car key-and-binding) (cdr key-and-binding)))
  79. +      key-binding-list))
  80.          ((equal wsys "xterm")
  81.       (mapcar
  82.        '(lambda (key-and-binding)
  83. ***************
  84. *** 148,154 ****
  85.       ;; Ensure Gillespie's Info mouse support is off since
  86.       ;; Hyperbole handles that.
  87.       (setq Info-mouse-support nil)
  88. !     (cond ((boundp 'epoch::version)
  89.          (setq mouse-set-point-command 'mouse::set-point)
  90.          (global-set-mouse mouse-middle mouse-down  'sm-depress)
  91.          (global-set-mouse mouse-middle mouse-up    'smart-key-mouse)
  92. --- 158,171 ----
  93.       ;; Ensure Gillespie's Info mouse support is off since
  94.       ;; Hyperbole handles that.
  95.       (setq Info-mouse-support nil)
  96. !     (cond ((string-match "Lucid" (emacs-version))
  97. !        (defun le:mouse-set-point() (mouse-set-point (copy-event last-input-event)
  98. ))
  99. !        (setq mouse-set-point-command 'le:mouse-set-point)
  100. !        (global-set-key 'button2 'sm-depress)
  101. !        (global-set-key 'button2up 'smart-key-mouse)
  102. !        (global-set-key 'button3 'sm-depress-meta)
  103. !        (global-set-key 'button3up 'smart-key-mouse-meta))
  104. !           ((boundp 'epoch::version)
  105.          (setq mouse-set-point-command 'mouse::set-point)
  106.          (global-set-mouse mouse-middle mouse-down  'sm-depress)
  107.          (global-set-mouse mouse-middle mouse-up    'smart-key-mouse)
  108. *** 1.1    1992/07/15 15:32:51
  109. --- hmouse-tag.el    1992/07/15 16:34:50
  110. ***************
  111. *** 37,42 ****
  112. --- 37,43 ----
  113.     ;; wtags is Bob Weiner's personal, unreleased changes to "tags.el" to
  114.     ;; do exact tag matching.  That package is not required to use this code.
  115.     (or (load "wtags" t)
  116. +       (and (string-match "Lucid" (emacs-version)) (load "etags"))
  117.         (and (load "tags") (provide 'tags))))
  118.  
  119.   ;;; ************************************************************************
  120. *** 1.1    1992/07/24 14:53:05
  121. --- hsite-ex.el    1992/07/24 14:53:23
  122. ***************
  123. *** 1,5 ****
  124.   ;;!emacs
  125. ! ;; $Id: hsite-ex.el,v 1.1 1992/07/24 14:53:05 jsparkes Exp jsparkes $
  126.   ;;
  127.   ;; FILE:         hsite.el
  128.   ;; SUMMARY:      Site-specific setup for Hyperbole
  129. --- 1,5 ----
  130.   ;;!emacs
  131. ! ;; $Id: hsite-ex.el,v 1.2 1992/05/14 10:11:45 rsw Exp $
  132.   ;;
  133.   ;; FILE:         hsite.el
  134.   ;; SUMMARY:      Site-specific setup for Hyperbole
  135. ***************
  136. *** 127,132 ****
  137. --- 127,153 ----
  138.       "Machine specific val for empty loop counter, Epoch but flash delay.")
  139.         )
  140.     (defun hui:but-flash ())
  141. +   )
  142. + ;;; Support button highlighting and flashing under Lucid emacs 19.
  143. + ;;;
  144. + (defvar hyperb:lucid-p
  145. +   (string-match "Lucid" (emacs-version))
  146. +   "Non-nil value indicates running Lucid emacs 19.")
  147. +
  148. + (defvar hyperb:use-lucid-menubar t
  149. +   "*Non-nil means to add the Hyperbole menu to the menubar under Lucid emacs."
  150. )
  151. +
  152. + (if hyperb:lucid-p
  153. +     (progn
  154. +       (require 'hui-lucid-b)
  155. +       (fset 'hui:but-flash 'le:but-flash)
  156. +       ;; This color cycling really must be done until a desired color is hit.
  157. +       (le:cycle-but-color)
  158. +       ;; If you use Epoch and find that the Hyperbole button flash time is
  159. +       ;; too slow or too fast, adjust it here.
  160. +       (defvar le:but-flash-time 1
  161. +     "Time to flash button under Lucid emacs, in seconds.")
  162. +       )
  163.     )
  164.  
  165.   ;;; You may want to look at this file just to see what it does.
  166. *** 1.1    1992/07/24 14:30:56
  167. --- hui-lucid-b.el    1992/07/24 14:30:30
  168. ***************
  169. *** 0 ****
  170. --- 1,317 ----
  171. + ;;!emacs
  172. + ;; $Id: hui-ep-but.el,v 1.2 1992/05/14 10:12:14 rsw Exp $
  173. + ;;
  174. + ;; FILE:         hui-lucid-b.el
  175. + ;; SUMMARY:      Support for highlighting/flashing buttons under Lucid emacs 1
  176. 9.
  177. + ;; USAGE:        Lucid emacs Lisp Library
  178. + ;;
  179. + ;; AUTHOR:       Bob Weiner; Jeff Sparkes
  180. + ;; ORG:          Brown U.; Bell-Northern Research
  181. + ;;
  182. + ;; ORIG-DATE:    27-Apr-91 at 05:37:10
  183. + ;; LAST-MOD:
  184. + ;;
  185. + ;; This file is part of Hyperbole.
  186. + ;; It is for use with Epoch, a modified version of GNU Emacs.
  187. + ;;
  188. + ;; Copyright (C) 1990, 1991, Brown University and Alan M. Carroll
  189. + ;; Developed with support from Motorola Inc.
  190. + ;; Available for use and distribution under the same terms as GNU Emacs.
  191. + ;;
  192. + ;; DESCRIPTION:
  193. + ;;
  194. + ;;   This is truly prototype code.
  195. + ;;
  196. +
  197. + ;;; ************************************************************************
  198. + ;;; Other required Elisp libraries
  199. + ;;; ************************************************************************
  200. +
  201. + (require 'hbut)
  202. +
  203. + ;;; ************************************************************************
  204. + ;;; Public variables
  205. + ;;; ************************************************************************
  206. +
  207. + ;;; ************************************************************************
  208. + ;;; Public functions
  209. + ;;; ************************************************************************
  210. +
  211. + (fset 'le:but-add 'epoch::add-button)
  212. +
  213. + (defun le:but-color ()
  214. +   "Return current color of buffer's buttons."
  215. +   (if le:color-ptr
  216. +       (car le:color-ptr)
  217. +     (face-foreground (find-face 'default))))
  218. +
  219. + (defun le:but-create (&optional start-delim end-delim regexp-match)
  220. +   "Mark all hyper-buttons in buffer as Lucid extents, for later highlighting.
  221. + Will use optional strings START-DELIM and END-DELIM instead of default values.
  222. + If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
  223. + expression which matches an entire button string.
  224. + If REGEXP-MATCH is non-nil, only buttons matching this argument are
  225. + highlighted."
  226. +   (save-excursion
  227. +     (map-extents (function (lambda (x y) (delete-extent x)))
  228. +          (current-buffer) (point-min) (point-max) nil))
  229. +   (le:but-create-all start-delim end-delim regexp-match))
  230. +
  231. + (defun le:but-create-all (&optional start-delim end-delim regexp-match)
  232. +   "Mark all hyper-buttons in buffer as Lucid extents, for later highlighting.
  233. + Will use optional strings START-DELIM and END-DELIM instead of default values.
  234. + If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
  235. + expression which matches an entire button string.
  236. + If REGEXP-MATCH is non-nil, only buttons matching this argument are
  237. + highlighted."
  238. +   (ebut:map '(lambda (lbl start end) (set-extent-attribute
  239. +                       (set-extent-face (make-extent start end)
  240. +                               'le:but)
  241. +                       'highlight))
  242. +     
  243. +         start-delim end-delim regexp-match 'include-delims))
  244. +     
  245. + (defun le:but-delete (&optional pos)
  246. +   (delete-extent (extent-at (or pos (point)))))
  247. +
  248. + ;;; ************************************************************************
  249. + ;;; Private functions
  250. + ;;; ************************************************************************
  251. +
  252. + (defmacro le:list-cycle (list-ptr list)
  253. +   "Move LIST-PTR to next element in LIST or when at end to first element."
  254. +   (` (or (and (, list-ptr)
  255. +           (setq (, list-ptr) (cdr (, list-ptr))))
  256. +      (setq (, list-ptr) (, list)))))
  257. +
  258. + ;;; ************************************************************************
  259. + ;;; Private variables
  260. + ;;; ************************************************************************
  261. +
  262. + (defconst le:color-list '( "red" "blue" "paleturquoise4" "mediumpurple2"
  263. + "lightskyblue3" "springgreen2" "salmon" "yellowgreen" "darkorchid2"
  264. + "aquamarine4" "slateblue4" "slateblue1" "olivedrab1" "goldenrod4"
  265. + "goldenrod3" "cadetblue2" "burlywood1" "slategrey" "mistyrose"
  266. + "limegreen" "lightcyan" "goldenrod" "gainsboro" "skyblue1" "honeydew"
  267. + "yellow2" "tomato3" "skyblue" "purple4" "orange3" "bisque3" "bisque2"
  268. + "grey34" "gray99" "gray63" "gray44" "gray37" "gray33" "gray26" "azure1"
  269. + "snow4" "peru" "red" "lightgoldenrod4" "mediumseagreen" "blush"
  270. + "mediumorchid2" "lightskyblue1" "darkslateblue" "midnightblue"
  271. + "lightsalmon1" "lemonchiffon" "yellow" "lightsalmon" "coral"
  272. + "dodgerblue3" "darkorange4" "blue" "royalblue4" "red" "green" "cyan"
  273. + "darkviolet" "darksalmon" "darkorange" "blue" "pink" "magenta2"
  274. + "sienna4" "khaki2" "grey75" "grey74" "grey73" "grey69" "grey68" "grey35"
  275. + "grey13" "gray90" "gray81" "gray55" "gray51" "gray31" "snow2" "pink3"
  276. + "grey7" "gray1" "red4" "red3" "tan" "red" "yellow" "mediumvioletred"
  277. + "lightslategrey" "lavenderblush4" "turquoise" "darkturquoise"
  278. + "darkslategrey" "lightskyblue" "lightsalmon4" "lightsalmon3"
  279. + "forestgreen" "dodgerblue4" "orchid" "rosybrown4" "brown" "peachpuff3"
  280. + "palegreen3" "orangered2" "rose" "lightcyan4" "indianred4" "indianred3"
  281. + "seagreen2" "indianred" "deeppink1" "navyblue" "lavender" "grey"
  282. + "deeppink" "salmon4" "salmon3" "oldlace" "grey78" "grey77" "grey54"
  283. + "grey45" "grey21" "gray97" "gray96" "gray95" "gray88" "gray87" "gray86"
  284. + "gray70" "gray57" "gray38" "gray12" "gray11" "plum3" "linen" "gray9"
  285. + "gray8" "blue4" "beige" "turquoise" "blue" "lemonchiffon4"
  286. + "darkseagreen1" "antiquewhite3" "mediumorchid" "springgreen"
  287. + "turquoise4" "steelblue3" "mistyrose2" "lightcyan2" "red" "firebrick2"
  288. + "royalblue" "cadetblue" "skyblue3" "yellow3" "salmon1" "orange4"
  289. + "hotpink" "grey90" "gray56" "gray39" "gray18" "gray14" "plum4" "grey6"
  290. + "gray6" "gold3" "gold1" "blue2" "tan2" "cyan" "mediumspringgreen"
  291. + "darkolivegreen2" "goldenrod" "lightsteelblue" "brown" "whip"
  292. + "chartreuse3" "violetred4" "royalblue2" "royalblue1" "papayawhip"
  293. + "mistyrose3" "lightcyan1" "aquamarine" "skyblue4" "hotpink4" "hotpink3"
  294. + "hotpink2" "dimgray" "tomato" "grey66" "grey65" "grey64" "grey33"
  295. + "grey27" "gray76" "gray69" "gray68" "grey0" "azure" "green"
  296. + "darkgoldenrod4" "darkgoldenrod3" "darkgoldenrod2" "darkgoldenrod"
  297. + "brown" "lightsalmon2" "deepskyblue4" "deepskyblue3" "deepskyblue2"
  298. + "deepskyblue" "darkorange1" "violetred3" "violetred2" "violetred1"
  299. + "slateblue3" "slateblue2" "drab" "indianred1" "firebrick1" "cadetblue4"
  300. + "violetred" "rosybrown" "blue" "firebrick" "grey100" "wheat4" "grey79"
  301. + "grey76" "grey61" "gray93" "gray84" "gray65" "gray36" "gray32" "gray13"
  302. + "gray10" "azure3" "snow1" "tan1" "gray" "darkolivegreen1" "blue"
  303. + "almond" "lavenderblush3" "lavenderblush2" "lavenderblush1"
  304. + "darkolivegreen" "lavenderblush" "aquamarine2" "red" "olivedrab2"
  305. + "mistyrose4" "mistyrose1" "lightcyan3" "lightcoral" "chartreuse"
  306. + "peachpuff" "palegreen" "mintcream" "skyblue2" "moccasin" "tomato1"
  307. + "orchid3" "maroon3" "salmon" "grey81" "grey62" "grey39" "grey38"
  308. + "grey37" "gray92" "gray83" "gray66" "gray54" "gray50" "gray30" "gray19"
  309. + "gray15" "azure4" "grey3" "tan3" "pink" "gray" "blue" "lightsteelblue2"
  310. + "lightsteelblue1" "green" "lightslategray" "lemonchiffon2"
  311. + "springgreen1" "greenyellow" "chartreuse2" "grey" "royalblue3"
  312. + "powderblue" "peachpuff2" "palegreen2" "cream" "slateblue" "seashell2"
  313. + "deeppink2" "darkkhaki" "maroon4" "sienna" "grey71" "grey67" "grey18"
  314. + "gray59" "gray43" "gray25" "bisque" "red1" "mediumslateblue"
  315. + "lightgoldenrod1" "goldenrod" "paleturquoise3" "lightskyblue4" "green"
  316. + "yellow" "smoke" "blue" "white" "steelblue4" "rosybrown3" "peachpuff1"
  317. + "palegreen1" "blueviolet" "seashell4" "sienna3" "grey40" "gray91"
  318. + "gray82" "gray5" "cyan2" "cyan1" "blue1" "snow" "lightgoldenrod2"
  319. + "lightslateblue" "mediumorchid3" "darkseagreen4" "springgreen3" "green"
  320. + "slategray4" "slategray3" "slategray2" "blue" "peachpuff4" "palegreen4"
  321. + "green" "orangered3" "goldenrod1" "ghostwhite" "firebrick4" "firebrick3"
  322. + "cadetblue3" "slategray" "seashell3" "honeydew3" "cornsilk4" "cornsilk2"
  323. + "purple1" "dimgrey" "khaki1" "ivory3" "grey70" "grey60" "grey32"
  324. + "grey22" "grey12" "gray98" "gray89" "gray71" "gray64" "gray60" "gray49"
  325. + "azure2" "gray3" "paleturquoise1" "mediumpurple1" "purple"
  326. + "lemonchiffon1" "blue" "navajowhite3" "darkorchid1" "orange"
  327. + "goldenrod2" "khaki" "chocolate2" "burlywood2" "honeydew1" "darkgreen"
  328. + "thistle3" "thistle2" "thistle1" "thistle" "maroon2" "maroon1" "grey53"
  329. + "grey44" "grey25" "gray74" "gray45" "gray41" "gray35" "gray27" "gray23"
  330. + "gray16" "brown4" "wheat" "coral" "tan4" "lightgoldenrodyellow" "blue"
  331. + "green" "gray" "palevioletred3" "mediumpurple4" "mediumpurple3"
  332. + "saddlebrown" "blue" "darkorchid4" "darkorchid3" "puff" "olivedrab4"
  333. + "lightblue4" "lightpink" "lightgray" "honeydew2" "cornsilk1" "lace"
  334. + "sienna1" "bisque4" "orchid" "khaki3" "grey84" "grey83" "grey82"
  335. + "grey72" "grey52" "grey43" "grey26" "grey14" "grey10" "gray75" "gray53"
  336. + "gray21" "gray20" "brown3" "grey8" "red2" "navy" "grey" "gold"
  337. + "mediumaquamarine" "lightgoldenrod" "darkslategray4" "darkseagreen3"
  338. + "darkseagreen2" "antiquewhite4" "white" "springgreen4" "lightyellow4"
  339. + "white" "aquamarine1" "turquoise3" "steelblue2" "rosybrown2" "pink"
  340. + "gray" "indianred2" "dodgerblue" "green" "seagreen1" "deeppink4"
  341. + "aliceblue" "magenta1" "pink" "sienna2" "orchid1" "gray100" "grey97"
  342. + "grey94" "grey87" "grey86" "grey51" "grey42" "grey19" "gray94" "gray85"
  343. + "gray61" "brown2" "khaki" "grey1" "gold4" "blue" "green" "grey"
  344. + "turquoise" "paleturquoise" "mediumorchid4" "antiquewhite2"
  345. + "lightyellow2" "violet" "salmon" "chartreuse1" "turquoise1" "sandybrown"
  346. + "orangered1" "lightpink1" "lightblue2" "lightblue1" "grey" "seagreen4"
  347. + "seagreen3" "lightblue" "deeppink3" "burlywood" "seashell" "hotpink1"
  348. + "gray" "yellow4" "yellow" "purple" "orange" "ivory4" "grey99" "grey89"
  349. + "grey63" "grey58" "grey49" "grey31" "grey24" "grey20" "green4" "green1"
  350. + "gray73" "gray67" "coral3" "coral2" "plum2" "pink4" "ivory" "gray4"
  351. + "gray2" "gold2" "aquamarine" "grey" "lightgoldenrod3" "darkolivegreen3"
  352. + "darkgoldenrod1" "goldenrod" "orchid" "chiffon" "navajowhite4"
  353. + "deepskyblue1" "lightyellow" "floralwhite" "blue" "mediumblue"
  354. + "chocolate4" "chocolate3" "burlywood4" "turquoise" "steelblue" "green"
  355. + "lawngreen" "honeydew4" "seagreen" "orchid4" "wheat1" "violet" "ivory1"
  356. + "grey88" "grey85" "grey57" "grey56" "grey55" "grey48" "grey47" "grey46"
  357. + "grey30" "grey17" "gray47" "gray29" "pink2" "grey5" "grey4" "green"
  358. + "gray0" "brown" "lightsteelblue4" "darkolivegreen4" "palevioletred4"
  359. + "blue" "darkslategray3" "darkslategray2" "darkslategray1"
  360. + "blanchedalmond" "palegoldenrod" "blue" "lightseagreen" "lemonchiffon3"
  361. + "darkslategray" "green" "darkseagreen" "antiquewhite" "darkorange2"
  362. + "chartreuse4" "blue" "rosybrown1" "olivedrab3" "lightpink2" "orangered"
  363. + "thistle4" "blue" "cornsilk" "salmon2" "orchid2" "ivory2" "grey93"
  364. + "grey92" "grey91" "grey36" "grey29" "grey28" "grey16" "gray79" "gray78"
  365. + "gray77" "gray48" "gray17" "coral4" "coral1" "plum1" "pink1" "grey9"
  366. + "grey2" "gray7" "cyan4" "blue3" "plum" "cornflowerblue" "lightskyblue2"
  367. + "antiquewhite1" "navajowhite2" "navajowhite1" "lightyellow3"
  368. + "navajowhite" "darkorange3" "whitesmoke" "turquoise2" "steelblue1"
  369. + "lightpink4" "lightblue3" "green" "chocolate1" "blue" "olivedrab"
  370. + "lightgrey" "chocolate" "magenta4" "magenta3" "yellow1" "purple3"
  371. + "purple2" "orange2" "orange1" "magenta" "bisque1" "wheat2" "maroon"
  372. + "khaki4" "grey96" "grey95" "grey80" "grey50" "grey41" "grey15" "grey11"
  373. + "gray80" "gray58" "gray40" "gray34" "gray22" "brown1" "snow3"
  374. + "mediumturquoise" "lightsteelblue3" "palevioletred2" "palevioletred1"
  375. + "paleturquoise2" "green" "palevioletred" "mediumorchid1" "white"
  376. + "mediumpurple" "lightyellow1" "dodgerblue2" "dodgerblue1" "violet"
  377. + "aquamarine3" "slategray1" "gray" "orangered4" "lightpink3" "blue"
  378. + "darkorchid" "cadetblue1" "burlywood3" "seashell1" "cornsilk3" "tomato4"
  379. + "tomato2" "wheat3" "grey98" "grey59" "grey23" "green3" "green2" "gray72"
  380. + "gray62" "gray52" "gray46" "gray42" "gray28" "gray24" "white" "cyan3"
  381. + "black" ))
  382. +
  383. + (defvar le:color-ptr nil
  384. +   "Pointer to current color name table to use for Hyperbole buttons in Lucid e
  385. macs.")
  386. +
  387. + (defconst le:good-colors
  388. +   '(
  389. +     "medium violet red" "indianred4" "firebrick1" "DarkGoldenrod" "NavyBlue"
  390. +     "darkorchid" "tomato3" "mediumseagreen" "deeppink" "forestgreen"
  391. +     "mistyrose4" "slategrey" "purple4" "dodgerblue3" "mediumvioletred"
  392. +     "lightsalmon3" "orangered2" "turquoise4" "Gray55"
  393. +     )
  394. +   "Good colors for contrast against wheat background and black foreground.")
  395. +
  396. +
  397. + (defvar le:item-highlight-color (face-foreground (find-face 'default))
  398. +   "Color with which to highlight list/menu selections.
  399. + Call (le:set-item-highlight <color>) to change value.")
  400. +
  401. + ;;; ************************************************************************
  402. + ;;; Public functions
  403. + ;;; ************************************************************************
  404. +
  405. + (defun le:cycle-but-color (&optional color)
  406. +   (interactive)
  407. +   (if (not (x-color-display-p))
  408. +       nil
  409. +     (if color (setq le:color-ptr nil))
  410. +     (set-face-foreground
  411. +      'le:but (or color (car (le:list-cycle le:color-ptr le:good-colors))))
  412. +     (set-face-background 'le:flash (le:but-color))
  413. +     (redraw-display)
  414. +     t))
  415. +
  416. + (defun le:but-flash ()
  417. +   "Flash a Hyperbole button at point to indicate selection, when using Epoch."
  418. +   (interactive)
  419. +   (let ((ibut) (prev)
  420. +     (start (hattr:get 'hbut:current 'lbl-start))
  421. +     (end   (hattr:get 'hbut:current 'lbl-end)))
  422. +     (and start end (setq prev (extent-at (point))
  423. +              ibut t)
  424. +      (if (not prev) (set-extent-face (make-extent start end) 'le:but)))
  425. +     (let* ((b (extent-at (point))))
  426. +       (if b
  427. +       (progn
  428. +         (set-extent-face b 'le:flash)
  429. +         (redraw-display)
  430. +         (add-timeout le:but-flash-time
  431. +              (function (lambda(b) (set-extent-face b 'le:but))) b)
  432. +         (redraw-display)
  433. +         )))
  434. +     (if (and ibut (not prev)) (le:but-delete))
  435. +     ))
  436. +
  437. + (defun le:set-item-highlight (&optional color-name)
  438. +   "Setup or reset item highlight style using optional color-name.
  439. + Currently does nothing so as not to intere with Lucid emacs highlighting."
  440. +   )
  441. +
  442. + (defun le:select-item (&optional pnt)
  443. +   "Select item in current buffer at optional position PNT using le:item-style.
  444. "
  445. +   (or le:item-button
  446. +       (setq le:item-button (set-extent-face (make-extent (point) (point))
  447. +                         'le:item-style)))
  448. +   (set-extent-attribute le:item-button 'highlight)
  449. +   (if pnt (goto-char pnt))
  450. +   (skip-chars-forward " \t")
  451. +   (skip-chars-backward "^ \t\n")
  452. +   (let ((start (point)))
  453. +     (save-excursion
  454. +       (skip-chars-forward "^ \t\n")
  455. +       (update-extent le:item-button start (point))
  456. +       ))
  457. +   (redraw-display)
  458. +   )
  459. +
  460. + (defun le:select-line (&optional pnt)
  461. +   "Select line in current buffer at optional position PNT using le:item-style.
  462. "
  463. +   (or le:item-button
  464. +       (setq le:item-button (set-extent-face (make-extent (point) (point))
  465. +                         'le:item-style)))
  466. +   (if pnt (goto-char pnt))
  467. +   (save-excursion
  468. +     (beginning-of-line)
  469. +     (update-extent le:item-button (point) (progn (end-of-line) (point)))
  470. +     )
  471. +   (redraw-display)
  472. +   )
  473. +
  474. + ;;; ************************************************************************
  475. + ;;; Private variables
  476. + ;;; ************************************************************************
  477. +
  478. + (or (find-face 'le:but) (copy-face 'default 'le:but))
  479. + (or (find-face 'le:flash) (copy-face 'default 'le:flash))
  480. +
  481. + (set-face-foreground 'le:but (le:but-color))
  482. + (set-face-background 'le:but (face-background (find-face 'default)))
  483. + (set-face-background 'le:flash (le:but-color))
  484. + (set-face-foreground 'le:flash (face-foreground (find-face 'default)))
  485. + (if (not (x-color-display-p))
  486. +     (make-face-bold 'le:but))
  487. +
  488. + (make-variable-buffer-local 'le:item-button)
  489. + (copy-face 'le:but 'le:item-style)
  490. +
  491. + (provide 'hui-lucid-b)
  492. *** 1.1    1992/07/15 18:52:15
  493. --- hui-menus.el    1992/07/24 14:46:23
  494. ***************
  495. *** 207,221 ****
  496.   Suitable for binding to a key, e.g. {C-h h}.
  497.   Non-interactively, returns t if menu is actually invoked by call, else nil."
  498.     (interactive)
  499. !   (condition-case ()
  500. !       (if hui:menu-p
  501. !       nil
  502. !     (setq hui:menu-p t)
  503. !     (hui:menu-act 'hyperbole)
  504. !     (setq hui:menu-p nil)
  505. !     t)
  506. !     (quit (setq hui:menu-p nil))
  507. !     (error (setq hui:menu-p nil))))
  508.  
  509.   (defun hui:menu-act (menu)
  510.     "Prompts user with Hyperbole MENU (a symbol) and performs selected item."
  511. --- 207,227 ----
  512.   Suitable for binding to a key, e.g. {C-h h}.
  513.   Non-interactively, returns t if menu is actually invoked by call, else nil."
  514.     (interactive)
  515. !   (let ((minibuffer-confirm-complete nil))
  516. !     (condition-case ()
  517. !     (if hui:menu-p
  518. !         nil
  519. !       ;; Attempt to work around a difference in Lucid emacs 19.  Hitting
  520. !       ;; C-G at the minibuffer prompt does not invoke the quit case in
  521. !       ;; this code. I don't really know why there even is a flag, but
  522. !       ;; not setting it seems to work here.  -Jeff Sparkes
  523. !       (if (not hyperb:lucid-p)
  524. !           (setq hui:menu-p t))
  525. !       (hui:menu-act 'hyperbole)
  526. !       (setq hui:menu-p nil)
  527. !       t)
  528. !       (quit (setq hui:menu-p nil))
  529. !       (error (setq hui:menu-p nil)))))
  530.  
  531.   (defun hui:menu-act (menu)
  532.     "Prompts user with Hyperbole MENU (a symbol) and performs selected item."
  533. ***************
  534. *** 252,258 ****
  535.     "Uses CHAR-STR or last input character as minibuffer argument."
  536.     (interactive)
  537.     (erase-buffer)
  538. !   (insert (or char-str (substring (recent-keys) -1)))
  539.     (exit-minibuffer))
  540.  
  541.   (defun hui:menu-help (help-str)
  542. --- 258,268 ----
  543.     "Uses CHAR-STR or last input character as minibuffer argument."
  544.     (interactive)
  545.     (erase-buffer)
  546. !   (if hyperb:lucid-p
  547. !       (insert (char-to-string
  548. !            (event-to-character
  549. !         (car (last (append (recent-keys) nil))))))
  550. !     (insert (or char-str (substring (recent-keys) -1))))
  551.     (exit-minibuffer))
  552.  
  553.   (defun hui:menu-help (help-str)
  554. ***************
  555. *** 360,364 ****
  556. --- 370,397 ----
  557.       (while (<= i 126)
  558.         (define-key hui:menu-mode-map (char-to-string i) 'hui:menu-enter)
  559.         (setq i (1+ i)))))
  560. +
  561. + (defun hui:menubar-do-menu (menus path)
  562. +   "Add the menu and it's entries to the menubar in Lucid emacs."
  563. +   (if (and menus (listp menus))
  564. +     (hui:menubar-do-menu-entry (cdr (cdr menus)) path)))
  565. +
  566. + (defun hui:menubar-do-menu-entry (menu path)
  567. +   "Process the list of Hyperbole MENUS for Lucid emacs menubar."
  568. +   (if menu
  569. +       (progn
  570. +     (let* ((entry (car menu))
  571. +            (name (car entry))
  572. +            (function (car (cdr entry))))
  573. +       (if (and (listp function)
  574. +            (assq (cdr function) hui:menus))    ; is this a submenu?
  575. +         (hui:menubar-do-menu (assq (cdr function) hui:menus)
  576. +                      (append path (list name)))
  577. +         (add-menu-item path name function t)))
  578. +     (hui:menubar-do-menu-entry (cdr menu) path))))
  579. +
  580. + (if hyperb:lucid-p
  581. +     (hui:menubar-do-menu (assq 'hyperbole hui:menus) '("Hyperbole")))
  582. +
  583.  
  584.   (provide 'hui-menus)
  585. --
  586. Jeff Sparkes
  587. jsparkes@bnr.ca    Bell-Northern Research, Ottawa, Ontario, Canada
  588.  
  589.  
  590.  
  591.