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