|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hui-mini.el
|
|
|
4 ;; SUMMARY: One line command menus for Hyperbole
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, mouse
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 15-Oct-91 at 20:13:17
|
|
114
|
12 ;; LAST-MOD: 17-Mar-97 at 21:28:26 by Bob Weiner
|
|
0
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
100
|
17 ;; Copyright (C) 1991-1997, Free Software Foundation, Inc.
|
|
0
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;; DESCRIP-END.
|
|
|
22
|
|
|
23 ;;; ************************************************************************
|
|
|
24 ;;; Other required Elisp libraries
|
|
|
25 ;;; ************************************************************************
|
|
|
26
|
|
|
27 (require 'hypb)
|
|
|
28
|
|
|
29 ;;; ************************************************************************
|
|
|
30 ;;; Public variables
|
|
|
31 ;;; ************************************************************************
|
|
|
32
|
|
|
33 (defvar hui:menu-select "\C-m"
|
|
|
34 "*Upper case char-string which selects the Hyperbole menu item at point.")
|
|
|
35 (defvar hui:menu-quit "Q"
|
|
|
36 "*Upper case char-string which quits selecting from a Hyperbole menu item.")
|
|
|
37 (defvar hui:menu-abort "\C-g"
|
|
|
38 "*Same function as 'hui:menu-quit'.")
|
|
|
39 (defvar hui:menu-top "\C-t"
|
|
|
40 "*Character which returns to top Hyperbole menu.")
|
|
|
41
|
|
|
42 (defvar hui:menu-p nil
|
|
|
43 "Non-nil iff a current Hyperbole menu activation exists.")
|
|
|
44
|
|
|
45 (defvar hui:menus nil
|
|
|
46 "Command menus for use with the default Hyperbole user interface.")
|
|
|
47 (setq
|
|
|
48 hui:menus
|
|
|
49 (delq nil
|
|
|
50 (list (cons
|
|
|
51 'hyperbole
|
|
|
52 (append
|
|
|
53 (let ((version (if (= (aref hyperb:version 0) ?0)
|
|
|
54 (substring hyperb:version 1)
|
|
|
55 hyperb:version)))
|
|
|
56 (list (list (concat "Hy" version ">"))))
|
|
|
57 (delq nil
|
|
|
58 (list
|
|
|
59 '("Act" hui:hbut-act
|
|
|
60 "Activates button at point or prompts for explicit button.")
|
|
|
61 '("Butfile/" (menu . butfile)
|
|
|
62 "Quick access button files menus.")
|
|
100
|
63 '("Cust/" (menu . cust)
|
|
|
64 "Customizes Hyperbole by setting major options.")
|
|
0
|
65 '("Doc/" (menu . doc)
|
|
|
66 "Quick access to Hyperbole documentation.")
|
|
|
67 '("Ebut/" (menu . ebut)
|
|
|
68 "Explicit button commands.")
|
|
|
69 '("Gbut/" (menu . gbut)
|
|
|
70 "Global button commands.")
|
|
|
71 '("Hist" (hhist:remove current-prefix-arg)
|
|
|
72 "Jumps back to location prior to last Hyperbole button follow.")
|
|
|
73 '("Ibut/" (menu . ibut)
|
|
|
74 "Implicit button and button type commands.")
|
|
|
75 '("Msg/" (menu . msg)
|
|
|
76 "Mail and News messaging facilities.")
|
|
|
77 (if hyperb:kotl-p
|
|
|
78 '("Otl/" (menu . otl)
|
|
|
79 "Autonumbered outlining and hyper-node facilities."))
|
|
|
80 '("Rolo/" (menu . rolo)
|
|
|
81 "Hierarchical, multi-file rolodex lookup and edit commands.")
|
|
|
82 '("Win/" (menu . win)
|
|
|
83 "Window configuration management command.")
|
|
|
84 ))))
|
|
|
85 '(butfile .
|
|
|
86 (("Butfile>")
|
|
|
87 ("DirFile" (find-file hbmap:filename)
|
|
|
88 "Edits directory-specific button file.")
|
|
|
89 ("Info"
|
|
|
90 (id-info "(hyperbole.info)Button Files")
|
|
|
91 "Displays manual section on button files.")
|
|
|
92 ("PersonalFile" (find-file
|
|
|
93 (expand-file-name hbmap:filename hbmap:dir-user))
|
|
|
94 "Edits user-specific button file.")
|
|
|
95 ))
|
|
100
|
96 '(cust .
|
|
|
97 (("Customize>")
|
|
|
98 ("Referent-Display/" (menu . cust-referents)
|
|
|
99 "Sets where referents are displayed.")
|
|
|
100 ("Smart-Key-at-Eol/" (menu . cust-eol)
|
|
|
101 "Sets how scrolling via end of line presses works.")
|
|
114
|
102 ("Toggle-Rolo-Dates"
|
|
|
103 (if (and (boundp 'wrolo-add-hook) (listp wrolo-add-hook)
|
|
|
104 (memq 'rolo-set-date wrolo-add-hook))
|
|
|
105 (progn (remove-hook 'wrolo-add-hook 'rolo-set-date)
|
|
|
106 (remove-hook 'wrolo-edit-hook 'rolo-set-date)
|
|
|
107 (message "Rolodex date stamps are now turned off."))
|
|
|
108 (add-hook 'wrolo-add-hook 'rolo-set-date)
|
|
|
109 (add-hook 'wrolo-edit-hook 'rolo-set-date)
|
|
|
110 (message "Rolodex date stamps are now turned on."))
|
|
|
111 "Toggle whether date stamps are update when rolodex entries are edited.")
|
|
100
|
112 ("URL-Display/" (menu . cust-urls) "Sets where URLs are displayed.")))
|
|
|
113 '(cust-eol .
|
|
|
114 (("Smart Key press at eol scrolls>")
|
|
|
115 ("Proportionally" (setq smart-scroll-proportional t))
|
|
|
116 ("Windowful" (setq smart-scroll-proportional nil))))
|
|
|
117 '(cust-referents .
|
|
|
118 (("Ref display>")
|
|
|
119 ("Any-Frame" (setq hpath:display-where 'other-frame))
|
|
|
120 ("Current-Win" (setq hpath:display-where 'this-window))
|
|
|
121 ("Diff-Frame-One-Win"
|
|
|
122 (setq hpath:display-where 'other-frame-one-window))
|
|
|
123 ("New-Frame" (setq hpath:display-where 'new-frame))
|
|
|
124 ("Other-Win" (setq hpath:display-where 'other-window))
|
|
|
125 ("Single-Win" (setq hpath:display-where 'one-window))))
|
|
|
126 '(cust-urls .
|
|
|
127 (("URL display>")
|
|
|
128 ("Any-Netscape-Window"
|
|
|
129 (setq action-key-url-function 'highlight-headers-follow-url-netscape
|
|
|
130 highlight-headers-follow-url-function action-key-url-function
|
|
|
131 highlight-headers-follow-url-netscape-new-window nil))
|
|
|
132 ("New-Netscape-Window"
|
|
|
133 (setq action-key-url-function 'highlight-headers-follow-url-netscape
|
|
|
134 highlight-headers-follow-url-function action-key-url-function
|
|
|
135 highlight-headers-follow-url-netscape-new-window t))
|
|
|
136 ("Mosaic" (setq action-key-url-function
|
|
|
137 'highlight-headers-follow-url-mosaic
|
|
|
138 highlight-headers-follow-url-function
|
|
|
139 action-key-url-function))
|
|
|
140 ("W3-Browser"
|
|
|
141 (setq action-key-url-function 'w3-fetch
|
|
|
142 highlight-headers-follow-url-function
|
|
|
143 action-key-url-function))))
|
|
0
|
144 '(doc .
|
|
|
145 (("Doc>")
|
|
100
|
146 ("About" (hypb:display-file-with-logo
|
|
|
147 (expand-file-name "ABOUT" hyperb:dir))
|
|
|
148 "Overview of Hyperbole and InfoDock Associates.")
|
|
0
|
149 ("Demo" (find-file-read-only
|
|
|
150 (expand-file-name "DEMO" hyperb:dir))
|
|
|
151 "Demonstrates Hyperbole features.")
|
|
|
152 ("Files" (find-file-read-only
|
|
|
153 (expand-file-name "MANIFEST" hyperb:dir))
|
|
|
154 "Summarizes Hyperbole system files. Click on an entry to view it.")
|
|
|
155 ("Glossary"
|
|
|
156 (id-info "(hyperbole.info)Glossary")
|
|
|
157 "Glossary of Hyperbole terms.")
|
|
|
158 ("HypbCopy" (id-info "(hyperbole.info)Top")
|
|
|
159 "Displays general Hyperbole copyright and license details.")
|
|
|
160 ("Info" (id-info "(hyperbole.info)Top")
|
|
|
161 "Online Info version of Hyperbole manual.")
|
|
|
162 ("MailLists" (id-info "(hyperbole.info)Mail Lists")
|
|
|
163 "Details on Hyperbole mail list subscriptions.")
|
|
|
164 ("New" (progn
|
|
|
165 (hact 'link-to-regexp-match
|
|
|
166 "\\*[ \t]+What's New" 2
|
|
|
167 (expand-file-name "README" hyperb:dir))
|
|
|
168 (setq buffer-read-only nil)
|
|
|
169 (toggle-read-only))
|
|
|
170 "Recent changes to Hyperbole.")
|
|
|
171 ("SmartKy" (find-file-read-only (hypb:mouse-help-file))
|
|
|
172 "Summarizes Smart Key mouse or keyboard handling.")
|
|
|
173 ("Types/" (menu . types)
|
|
|
174 "Provides documentation on Hyperbole types.")
|
|
|
175 ))
|
|
|
176 '(ebut .
|
|
|
177 (("EButton>")
|
|
|
178 ("Act" hui:hbut-act
|
|
|
179 "Activates button at point or prompts for explicit button.")
|
|
|
180 ("Create" hui:ebut-create)
|
|
|
181 ("Delete" hui:ebut-delete)
|
|
|
182 ("Edit" hui:ebut-modify "Modifies any desired button attributes.")
|
|
|
183 ("Help/" (menu . ebut-help) "Summarizes button attributes.")
|
|
|
184 ("Info"
|
|
|
185 (id-info "(hyperbole.info)Explicit Buttons")
|
|
|
186 "Displays manual section on explicit buttons.")
|
|
|
187 ("Modify" hui:ebut-modify "Modifies any desired button attributes.")
|
|
|
188 ("Rename" hui:ebut-rename "Relabels an explicit button.")
|
|
|
189 ("Search" hui:ebut-search
|
|
|
190 "Locates and displays personally created buttons in context.")
|
|
|
191 ))
|
|
|
192 '(ebut-help .
|
|
|
193 (("Help on>")
|
|
|
194 ("BufferButs" (hui:hbut-report -1)
|
|
|
195 "Summarizes all explicit buttons in buffer.")
|
|
|
196 ("CurrentBut" (hui:hbut-report)
|
|
|
197 "Summarizes only current button in buffer.")
|
|
|
198 ("OrderedButs" (hui:hbut-report 1)
|
|
|
199 "Summarizes explicit buttons in lexicographically order.")
|
|
|
200 ))
|
|
|
201 '(gbut .
|
|
|
202 (("GButton>")
|
|
|
203 ("Act" gbut:act "Activates global button by name.")
|
|
|
204 ("Create" hui:gbut-create "Adds a global button to gbut:file.")
|
|
|
205 ("Edit" hui:gbut-modify "Modifies global button attributes.")
|
|
|
206 ("Help" gbut:help "Reports on a global button by name.")
|
|
|
207 ("Info" (id-info "(hyperbole.info)Global Buttons")
|
|
|
208 "Displays manual section on global buttons.")
|
|
|
209 ("Modify" hui:gbut-modify "Modifies global button attributes.")
|
|
|
210 ))
|
|
|
211 '(ibut .
|
|
|
212 (("IButton>")
|
|
100
|
213 ("Act" hui:hbut-current-act "Activates implicit button at point.")
|
|
0
|
214 ("DeleteIButType" (hui:htype-delete 'ibtypes)
|
|
|
215 "Deletes specified button type.")
|
|
|
216 ("Help" hui:hbut-help "Reports on button's attributes.")
|
|
|
217 ("Info" (id-info "(hyperbole.info)Implicit Buttons")
|
|
|
218 "Displays manual section on implicit buttons.")
|
|
|
219 ("Types" (hui:htype-help 'ibtypes 'no-sort)
|
|
|
220 "Displays documentation for one or all implicit button types.")
|
|
|
221 ))
|
|
|
222 '(msg .
|
|
|
223 (("Msg>")
|
|
|
224 ("Compose-Hypb-Mail"
|
|
100
|
225 (hmail:compose "hyperbole@infodock.com" '(hact 'hyp-config))
|
|
0
|
226 "Send a message to the Hyperbole discussion list.")
|
|
|
227 ("Edit-Hypb-List-Entry"
|
|
100
|
228 (hmail:compose "hyperbole-request@infodock.com"
|
|
0
|
229 '(hact 'hyp-request))
|
|
|
230 "Add, remove or change your entry on a the Hyperbole mail list.")
|
|
|
231 ("Modify-Hypb-Announce-Entry"
|
|
100
|
232 (hmail:compose "hyperbole-announce-request@infodock.com"
|
|
0
|
233 '(hact 'hyp-request))
|
|
|
234 "Add, remove or change your entry on the Hyperbole Announce mail list.")
|
|
|
235 ))
|
|
|
236 (if hyperb:kotl-p
|
|
|
237 '(otl
|
|
|
238 . (("Otl>")
|
|
|
239 ("All" kotl-mode:show-all "Expand all collapsed cells.")
|
|
|
240 ("Blanks" kvspec:toggle-blank-lines
|
|
|
241 "Toggle blank lines between cells on or off.")
|
|
|
242 ("Create" kfile:find "Create or edit an outline file.")
|
|
|
243 ("Downto" kotl-mode:hide-sublevels
|
|
|
244 "Hide all cells in outline deeper than a particular level.")
|
|
|
245 ("Examp" (find-file-read-only
|
|
|
246 (expand-file-name
|
|
|
247 "EXAMPLE.kotl" (concat hyperb:dir "kotl/")))
|
|
|
248 "Display a self-descriptive example outline file.")
|
|
|
249 ("Hide" (progn (kotl-mode:is-p)
|
|
|
250 (kotl-mode:hide-tree (kcell-view:label)))
|
|
|
251 "Collapse tree rooted at point.")
|
|
|
252 ("Info"
|
|
|
253 (id-info "(hyperbole.info)Outliner")
|
|
|
254 "Display manual section on Hyperbole outliner.")
|
|
|
255 ("Kill" kotl-mode:kill-tree
|
|
|
256 "Kill ARG following trees starting from point.")
|
|
|
257 ("Link" klink:create
|
|
|
258 "Create and insert an implicit link at point.")
|
|
|
259 ("Overvw" kotl-mode:overview
|
|
|
260 "Show first line of each cell.")
|
|
|
261 ("Show" (progn (kotl-mode:is-p)
|
|
|
262 (kotl-mode:show-tree (kcell-view:label)))
|
|
|
263 "Expand tree rooted at point.")
|
|
|
264 ("Top" kotl-mode:top-cells
|
|
|
265 "Hide all but top-level cells.")
|
|
|
266 ("Vspec" kvspec:activate
|
|
|
267 "Prompt for and activate a view specifiction.")
|
|
|
268 )))
|
|
|
269 '(rolo .
|
|
|
270 (("Rolo>")
|
|
|
271 ("Add" rolo-add "Add a new rolo entry.")
|
|
|
272 ("Display" rolo-display-matches
|
|
|
273 "Display last found rolodex matches again.")
|
|
|
274 ("Edit" rolo-edit "Edit an existing rolo entry.")
|
|
|
275 ("Info" (id-info "(hyperbole.info)Rolodex")
|
|
|
276 "Displays manual section on Hyperbole rolodex.")
|
|
|
277 ("Kill" rolo-kill "Kill an existing rolo entry.")
|
|
|
278 ("Mail" rolo-mail-to "Mail to address following point.")
|
|
|
279 ("Order" rolo-sort "Order rolo entries in a file.")
|
|
|
280 ("RegexFind" rolo-grep "Find entries containing a regexp.")
|
|
|
281 ("StringFind" rolo-fgrep "Find entries containing a string.")
|
|
|
282 ("WordFind" rolo-word "Find entries containing words.")
|
|
|
283 ("Yank" rolo-yank
|
|
|
284 "Find an entry containing a string and insert it at point.")
|
|
|
285 ))
|
|
|
286 '(types .
|
|
|
287 (("Types>")
|
|
|
288 ("ActionTypes" (hui:htype-help 'actypes)
|
|
|
289 "Displays documentation for one or all action types.")
|
|
|
290 ("IButTypes" (hui:htype-help 'ibtypes 'no-sort)
|
|
|
291 "Displays documentation for one or all implicit button types.")
|
|
|
292 ))
|
|
|
293 '(win .
|
|
|
294 (("WinConfig>")
|
|
|
295 ("AddName" wconfig-add-by-name
|
|
|
296 "Name current window configuration.")
|
|
|
297 ("DeleteName" wconfig-delete-by-name
|
|
|
298 "Delete named window configuration.")
|
|
|
299 ("RestoreName" wconfig-restore-by-name
|
|
|
300 "Restore frame to window configuration given by name.")
|
|
|
301 ("PopRing" (progn (wconfig-delete-pop)
|
|
|
302 (hyperbole 'win))
|
|
|
303 "Restores window configuration from ring and removes it from ring.")
|
|
|
304 ("SaveRing" (wconfig-ring-save)
|
|
|
305 "Saves current window configuration to ring.")
|
|
|
306 ("YankRing" (progn (call-interactively 'wconfig-yank-pop)
|
|
|
307 (hyperbole 'win))
|
|
|
308 "Restores next window configuration from ring.")
|
|
|
309 ))
|
|
|
310 )))
|
|
|
311
|
|
|
312 ;;; ************************************************************************
|
|
|
313 ;;; Public functions
|
|
|
314 ;;; ************************************************************************
|
|
|
315
|
|
|
316 ;;; Old name
|
|
|
317 (fset 'hui:menu 'hyperbole)
|
|
|
318
|
|
|
319 ;;; Used as autoloaded main entry point to Hyperbole (but hsite.el) is the
|
|
|
320 ;;; file that is autoloaded when this is invoked.
|
|
|
321 ;;; It brings up a menu of commands.
|
|
108
|
322 ;;;###autoload
|
|
0
|
323 (defun hyperbole (&optional menu menu-list)
|
|
|
324 "Invokes default Hyperbole menu user interface when not already active.
|
|
|
325 Suitable for binding to a key, e.g. {C-h h}.
|
|
|
326 Non-interactively, returns t if menu is actually invoked by call, else nil.
|
|
|
327
|
|
|
328 Two optional arguments may be given to invoke alternative menus.
|
|
|
329 MENU (a symbol) specifies the menu to invoke from MENU-LIST, (a
|
|
|
330 Hyperbole menu list structure). MENU defaults to 'hyperbole and MENU-LIST
|
|
|
331 to `hui:menus'. See `hui:menus' definition for the format of the menu list
|
|
|
332 structure."
|
|
|
333
|
|
|
334 (interactive)
|
|
|
335 (if (and hui:menu-p (> (minibuffer-depth) 0))
|
|
|
336 (progn (beep) nil)
|
|
|
337 (unwind-protect
|
|
|
338 (progn
|
|
|
339 (require 'hsite) ;; Since "hui-mini" may be loaded without loading
|
|
|
340 ;; all of Hyperbole.
|
|
|
341 (hyperb:init-menubar)
|
|
|
342 (setq hui:menu-p t)
|
|
|
343 (hui:menu-act (or menu 'hyperbole) menu-list)
|
|
|
344 t)
|
|
|
345 (setq hui:menu-p nil))))
|
|
|
346
|
|
|
347 (defun hui:menu-act (menu &optional menu-list)
|
|
|
348 "Prompts user with Hyperbole MENU (a symbol) and performs selected item.
|
|
|
349 Optional second argument MENU-LIST is a Hyperbole menu list structure from
|
|
|
350 which to extract MENU. It defaults to `hui:menus'. See its definition for
|
|
|
351 the menu list structure."
|
|
|
352 (let ((set-menu '(or (and menu (symbolp menu)
|
|
|
353 (setq menu-alist
|
|
|
354 (cdr (assq menu (or menu-list hui:menus)))))
|
|
|
355 (hypb:error "(menu-act): Invalid menu symbol arg: %s"
|
|
|
356 menu)))
|
|
|
357 (show-menu t)
|
|
|
358 (rtn)
|
|
|
359 menu-alist act-form)
|
|
|
360 (while (and show-menu (eval set-menu))
|
|
|
361 (cond ((and (consp (setq act-form (hui:menu-select menu-alist)))
|
|
|
362 (cdr act-form)
|
|
|
363 (symbolp (cdr act-form)))
|
|
|
364 ;; Display another menu
|
|
|
365 (setq menu (cdr act-form)))
|
|
|
366 (act-form
|
|
|
367 (let ((prefix-arg current-prefix-arg))
|
|
|
368 (cond ((symbolp act-form)
|
|
|
369 (if (eq act-form t)
|
|
|
370 nil
|
|
|
371 (setq show-menu nil
|
|
|
372 rtn (call-interactively act-form))))
|
|
|
373 ((stringp act-form)
|
|
|
374 (hui:menu-help act-form)
|
|
|
375 ;; Loop and show menu again.
|
|
|
376 )
|
|
|
377 (t (setq show-menu nil
|
|
|
378 rtn (eval act-form))))))
|
|
|
379 (t (setq show-menu nil))))
|
|
|
380 rtn))
|
|
|
381
|
|
|
382 (defun hui:menu-enter (&optional char-str)
|
|
|
383 "Uses CHAR-STR or last input character as minibuffer argument."
|
|
|
384 (interactive)
|
|
|
385 (let ((input (or char-str (aref (recent-keys) (1- (length (recent-keys)))))))
|
|
|
386 (cond (hyperb:emacs19-p
|
|
|
387 (and (not (integerp input))
|
|
|
388 (eventp input)
|
|
|
389 (setq input (event-basic-type input))))
|
|
|
390 (hyperb:lemacs-p
|
|
|
391 (if (eventp input)
|
|
|
392 (setq input (event-to-character input)))))
|
|
|
393 (if (or (symbolp input)
|
|
|
394 (and (integerp input)
|
|
|
395 (= input ?\r)))
|
|
|
396 (setq input (hargs:at-p)))
|
|
|
397 (erase-buffer)
|
|
|
398 (or (symbolp input) (insert input)))
|
|
|
399 (exit-minibuffer))
|
|
|
400
|
|
|
401 (defun hui:menu-help (help-str)
|
|
|
402 "Displays HELP-STR in a small window. HELP-STR must be a string."
|
|
|
403 (let* ((window-min-height 2)
|
|
|
404 (owind (selected-window))
|
|
|
405 (buf-name (hypb:help-buf-name "Menu")))
|
|
|
406 (unwind-protect
|
|
|
407 (progn
|
|
|
408 (save-window-excursion
|
|
|
409 (hkey-help-show buf-name)) ;; Needed to save wconfig.
|
|
|
410 (if (eq (selected-window) (minibuffer-window))
|
|
|
411 (other-window 1))
|
|
|
412 (if (= (length (hypb:window-list 'no-mini)) 1)
|
|
|
413 (split-window-vertically nil))
|
|
|
414 (select-window (hui:bottom-window))
|
|
|
415 (switch-to-buffer (get-buffer-create buf-name))
|
|
|
416 (setq buffer-read-only nil)
|
|
|
417 (erase-buffer)
|
|
|
418 (insert "\n" help-str)
|
|
|
419 (set-buffer-modified-p nil)
|
|
|
420 (shrink-window
|
|
|
421 (- (window-height)
|
|
|
422 (+ 3 (length
|
|
|
423 (delq nil
|
|
|
424 (mapcar (function
|
|
|
425 (lambda (chr) (= chr ?\n)))
|
|
|
426 help-str)))))))
|
|
|
427 (select-window owind))))
|
|
|
428
|
|
|
429 (defun hui:menu-xemacs (&optional menu menu-list)
|
|
|
430 "Returns an XEmacs menu built from Hyperbole type menus.
|
|
|
431 Optional MENU (a symbol) specifies a specific submenu of optional MENU-LIST.
|
|
|
432 a Hyperbole menu list structure. Otherwise, all menus are used.
|
|
|
433 MENU defaults to 'hyperbole and MENU-LIST to `hui:menus'. See `hui:menus'
|
|
|
434 definition for the format of the menu list structure."
|
|
|
435 (mapcar
|
|
|
436 (function
|
|
|
437 (lambda (entry)
|
|
|
438 (or (consp entry)
|
|
|
439 (error "(hui:menu-xemacs): Invalid menu entry: %s" entry))
|
|
|
440 (let ((label (car entry))
|
|
|
441 (content (car (cdr entry))))
|
|
|
442 (cond ((null content) (hypb:replace-match-string ">$" label "" t))
|
|
|
443 ((and (consp content) (eq (car content) 'menu))
|
|
|
444 (hui:menu-xemacs (cdr content)))
|
|
|
445 (t (vector label content 't))))))
|
|
|
446 (cdr (assq (or menu 'hyperbole) (or menu-list hui:menus)))))
|
|
|
447
|
|
|
448 (defun hui:menu-select (menu-alist)
|
|
|
449 "Prompts user to choose the first character of any item from MENU-ALIST.
|
|
|
450 Case is not significant. If chosen by direct selection with the Assist Key,
|
|
|
451 returns any help string for item, else returns the action form for the item."
|
|
|
452 (let* ((menu-line (hui:menu-line menu-alist))
|
|
|
453 (set:equal-op 'eq)
|
|
|
454 (select-char (string-to-char hui:menu-select))
|
|
|
455 (quit-char (string-to-char hui:menu-quit))
|
|
|
456 (abort-char (string-to-char hui:menu-abort))
|
|
|
457 (top-char (string-to-char hui:menu-top))
|
|
|
458 (item-keys (mapcar (function
|
|
|
459 (lambda (item) (aref item 0)))
|
|
|
460 (mapcar 'car (cdr menu-alist))))
|
|
|
461 (keys (apply 'list select-char quit-char abort-char
|
|
|
462 top-char item-keys))
|
|
|
463 (key 0)
|
|
|
464 (hargs:reading-p 'hmenu)
|
|
|
465 sublist)
|
|
|
466 (while (not (memq (setq key (upcase
|
|
|
467 (string-to-char
|
|
|
468 (read-from-minibuffer
|
|
|
469 "" menu-line hui:menu-mode-map))))
|
|
|
470 keys))
|
|
|
471 (beep)
|
|
|
472 (setq hargs:reading-p 'hmenu)
|
|
|
473 (discard-input))
|
|
|
474 (cond ((eq key quit-char) nil)
|
|
|
475 ((eq key abort-char) (beep) nil)
|
|
|
476 ((eq key top-char) '(menu . hyperbole))
|
|
|
477 ((and (eq key select-char)
|
|
|
478 (save-excursion
|
|
|
479 (if (search-backward " " nil t)
|
|
|
480 (progn (skip-chars-forward " ")
|
|
|
481 (setq key (following-char))
|
|
|
482 nil) ;; Drop through.
|
|
|
483 t))))
|
|
|
484 (t (if (setq sublist (memq key item-keys))
|
|
|
485 (let* ((label-act-help-list
|
|
|
486 (nth (- (1+ (length item-keys)) (length sublist))
|
|
|
487 menu-alist))
|
|
|
488 (act-form (car (cdr label-act-help-list))))
|
|
|
489 (if (eq hargs:reading-p 'hmenu-help)
|
|
|
490 (let ((help-str
|
|
|
491 (or (car (cdr (cdr label-act-help-list)))
|
|
|
492 "No help documentation for this item.")))
|
|
|
493 (concat (car label-act-help-list) "\n "
|
|
|
494 help-str "\n Action: "
|
|
|
495 (prin1-to-string act-form)))
|
|
|
496 act-form)))))))
|
|
|
497
|
|
|
498 ;;; ************************************************************************
|
|
|
499 ;;; Private functions
|
|
|
500 ;;; ************************************************************************
|
|
|
501
|
|
|
502 (if (fboundp 'window-lowest-p)
|
|
|
503 (defun hui:bottom-window ()
|
|
|
504 "Return a window that is at the bottom of the selected frame."
|
|
|
505 (let ((winds (hypb:window-list 'no-mini))
|
|
|
506 (window))
|
|
|
507 (while (and (not window) winds)
|
|
|
508 (if (window-lowest-p (car winds))
|
|
|
509 (setq window (car winds))
|
|
|
510 (setq winds (cdr winds))))
|
|
|
511 window))
|
|
|
512 (defun hui:bottom-window ()
|
|
|
513 "Return a window that is at the bottom of the selected frame."
|
|
|
514 (let* ((winds (hypb:window-list 'no-mini))
|
|
|
515 (bot-list (mapcar
|
|
|
516 (function
|
|
|
517 (lambda (wind)
|
|
|
518 (nth 3 (window-edges wind))))
|
|
|
519 winds))
|
|
|
520 (bot (apply 'max bot-list)))
|
|
|
521 (nth (- (length winds) (length (memq bot bot-list))) winds))))
|
|
|
522
|
|
|
523 (defun hui:menu-line (menu-alist)
|
|
|
524 "Returns a menu line string built from MENU-ALIST."
|
|
|
525 (let ((menu-prompt (concat (car (car menu-alist)) " "))
|
|
|
526 (menu-items (mapconcat 'car (cdr menu-alist) " "))
|
|
|
527 menu-line)
|
|
|
528 (setq menu-line (concat menu-prompt menu-items))
|
|
|
529 ;; Narrow menu by changing 2 spaces to 1 if too wide for current frame.
|
|
|
530 (if (>= (length menu-line) (1- (frame-width)))
|
|
|
531 (concat menu-prompt (mapconcat 'car (cdr menu-alist) " "))
|
|
|
532 menu-line)))
|
|
|
533
|
|
|
534 ;;; ************************************************************************
|
|
|
535 ;;; Private variables
|
|
|
536 ;;; ************************************************************************
|
|
|
537
|
|
|
538 ;; Hyperbole menu mode is suitable only for specially formatted data.
|
|
|
539 (put 'hui:menu-mode 'mode-class 'special)
|
|
|
540
|
|
|
541 (defvar hui:menu-mode-map nil
|
|
|
542 "Keymap containing hui:menu commands.")
|
|
|
543 (if hui:menu-mode-map
|
|
|
544 nil
|
|
|
545 (setq hui:menu-mode-map (make-keymap))
|
|
|
546 (suppress-keymap hui:menu-mode-map)
|
|
|
547 (define-key hui:menu-mode-map hui:menu-quit 'hui:menu-enter)
|
|
|
548 (define-key hui:menu-mode-map hui:menu-abort 'hui:menu-enter)
|
|
|
549 (define-key hui:menu-mode-map hui:menu-top 'hui:menu-enter)
|
|
|
550 (define-key hui:menu-mode-map hui:menu-select 'hui:menu-enter)
|
|
|
551 ;;
|
|
|
552 ;; This next binding is necessary since the default button1 binding under
|
|
|
553 ;; XEmacs, mouse-track, is broken under XEmacs V19.8.
|
|
|
554 (and hyperb:lemacs-p window-system
|
|
|
555 (define-key hui:menu-mode-map 'button1 'mouse-set-point))
|
|
|
556 (let ((i 32))
|
|
|
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 (provide 'hui-mini)
|
