comparison lisp/hyperbole/hyperbole.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; LCD-ENTRY: See "hversion.el".
4 ;;
5 ;; FILE: hyperbole.el
6 ;; SUMMARY: Sets up Hyperbole for autoloading and use.
7 ;; USAGE: GNU Emacs Lisp Library
8 ;; KEYWORDS: hypermedia
9 ;;
10 ;; AUTHOR: Bob Weiner
11 ;; ORG: Motorola, Inc., PWDG
12 ;;
13 ;; ORIG-DATE: 6-Oct-92 at 11:52:51
14 ;; LAST-MOD: 3-Nov-95 at 23:14:52 by Bob Weiner
15 ;;
16 ;; This file is part of Hyperbole.
17 ;; Available for use and distribution under the same terms as GNU Emacs.
18 ;;
19 ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
20 ;; Developed with support from Motorola Inc.
21 ;;
22 ;; DESCRIPTION:
23 ;;
24 ;; See the "README" file for installation instructions.
25 ;;
26 ;; There is no need to manually edit this file unless there are specific
27 ;; customizations you would like to make, such as whether the Hyperbole
28 ;; mouse buttons are placed on shifted or unshifted mouse buttons.
29 ;; (See the call of the function, hmouse-shift-buttons, below.)
30 ;;
31 ;; Other site-specific customizations belong in "hsite.el" which is created
32 ;; from "hsite-ex.el" by the person who installs Hyperbole at your site.
33 ;;
34 ;; DESCRIP-END.
35
36 ;;; ************************************************************************
37 ;;; Hyperbole directory setting
38 ;;; ************************************************************************
39
40 ;; Defines hyperb:window-system, hyperb:kotl-p and
41 ;; (hyperb:path-being-loaded), which are used below.
42 ;; The Hyperbole distribution directory must either already be in
43 ;; load-path or an explicit load of "hversion" must have been
44 ;; done already or else the following line will fail to load hversion.
45 ;; This is all documented in the Hyperbole installation instructions.
46 (require 'hversion)
47
48 ;; Reinitialize hyperb:dir on reload if initialization failed for any reason.
49 (and (boundp 'hyperb:dir) (null hyperb:dir) (makunbound 'hyperb:dir))
50
51 (defvar hyperb:dir (if (fboundp 'backtrace-frame) (hyperb:path-being-loaded))
52 "Directory where the Hyperbole executable code is kept.
53 It must end with a directory separator character.")
54 (if (stringp hyperb:dir)
55 (setq hyperb:dir (file-name-directory hyperb:dir))
56 (error
57 "(hyperbole.el): Failed to set hyperb:dir. Try setting it manually."))
58
59 ;;; ************************************************************************
60 ;;; Other required Elisp libraries
61 ;;; ************************************************************************
62
63 (require 'set (expand-file-name "set" hyperb:dir))
64
65 ;; Add hyperb:dir and kotl subdirectory to load-path so other
66 ;; Hyperbole libraries can be found.
67 (setq load-path (set:add hyperb:dir load-path))
68 (if hyperb:kotl-p
69 (setq load-path (set:add (expand-file-name "kotl/" hyperb:dir) load-path)))
70
71 (require 'hvar) ;; Defines var:append function.
72
73 ;;; ************************************************************************
74 ;;; Public key bindings
75 ;;; ************************************************************************
76
77 ;;; Setup so Hyperbole can be autoloaded from a key.
78 ;;; Choose a key on which to place the Hyperbole menus.
79 ;;; For most people this key binding will work and will be equivalent
80 ;;; to {C-h h}.
81 ;;;
82 (or (where-is-internal 'hyperbole)
83 (where-is-internal 'hui:menu)
84 (define-key help-map "h" 'hyperbole))
85
86 ;;; Provides a site standard way of emulating most Hyperbole mouse drag
87 ;;; commands from the keyboard. This is most useful for rapidly creating
88 ;;; Hyperbole link buttons from the keyboard without invoking the Hyperbole
89 ;;; menu. Only works if Emacs is run under a window system.
90 ;;;
91 (or (not hyperb:window-system)
92 (global-key-binding "\M-o")
93 (where-is-internal 'hkey-operate)
94 (global-set-key "\M-o" 'hkey-operate))
95
96 ;;; Provides a site standard way of performing explicit button
97 ;;; renames without invoking the Hyperbole menu.
98 ;;;
99 (or (global-key-binding "\C-c\C-r")
100 (where-is-internal 'hui:ebut-rename)
101 (global-set-key "\C-c\C-r" 'hui:ebut-rename))
102
103 ;;; The following operations are now available through the Hyperbole Win/
104 ;;; menu. In earlier versions of Hyperbole, each of these operations had its
105 ;;; own keybindings. Uncomment the following code lines if you still want
106 ;;; to use those key bindings.
107 ;;; Key bindings for window configuration save/restore ring, like kill-ring
108 ;;; except holds the configuration of windows within a frame.
109 ;;; {C-x 4 w} to save config; {C-x 4 y} to restore successive
110 ;;; saves; {C-x 4 DEL} to delete successive saves.
111 ;;;
112 ;; (or (global-key-binding "\C-x4w")
113 ;; (global-set-key "\C-x4w" 'wconfig-ring-save))
114 ;; (or (global-key-binding "\C-x4y")
115 ;; (global-set-key "\C-x4y" 'wconfig-yank-pop))
116 ;; (or (global-key-binding "\C-x4\177")
117 ;; (global-set-key "\C-x4\177" 'wconfig-delete-pop))
118
119 ;;; Provides a site standard way to easily switch between the Hyperbole mouse
120 ;;; bindings and a set of personal mouse bindings. You may instead show
121 ;;; users how to bind this to a key via 'hyperb:init-hook' (see
122 ;;; Hyperbole Manual).
123 ;;;
124 (or (global-key-binding "\C-ct")
125 (where-is-internal 'hmouse-toggle-bindings)
126 (global-set-key "\C-ct" 'hmouse-toggle-bindings))
127
128 (defun hkey-either (arg)
129 "Executes `action-key' or with non-nil ARG executes `assist-key'."
130 (interactive "P")
131 (if arg (assist-key) (action-key)))
132
133 ;;; A value of t for 'hkey-init' below will cause the Hyperbole
134 ;;; context-sensitive keys to be bound to keyboard keys, in addition to any
135 ;;; mouse key bindings. Comment it out or set it to nil if you don't want
136 ;;; these bindings. Or change the bindings in the succeeding lines.
137 ;;;
138 (or (boundp 'hkey-init) (setq hkey-init t))
139 (and hkey-init
140 (not (global-key-binding "\M-\C-m"))
141 (global-set-key "\M-\C-m" 'hkey-either))
142 ;;
143 ;; Bind a key, {C-h A}, for Action Key help and {C-u C-h A} for Assist key
144 ;; help.
145 (and hkey-init
146 (not (where-is-internal 'hkey-help))
147 (define-key help-map "A" 'hkey-help))
148
149 ;;;
150 ;;; Hyperbole key bindings for many non-edit modes.
151 ;;; Set both to nil if unwanted.
152 ;;;
153 (defvar action-key-read-only "\C-m"
154 "Local Action Key binding for special read-only modes.")
155 (defvar assist-key-read-only "\M-\C-m"
156 "Local Assist Key binding for special read-only modes.")
157
158 ;;; ************************************************************************
159 ;;; URL Browsing
160 ;;; ************************************************************************
161
162 ;;;###autoload
163 (defvar action-key-url-function 'w3-fetch
164 "Value is a function of one argument, a url, which displays the url referent.
165 Possible values are:
166 w3-fetch - display using the W3 Emacs web browser;
167 highlight-headers-follow-url-netscape - display in Netscape;
168 highlight-headers-follow-url-mosaic - display in Mosaic.")
169
170 ;;; ************************************************************************
171 ;;; Koutliner mode and file suffix importation settings.
172 ;;; ************************************************************************
173
174 ;;;###autoload
175 (defvar kimport:mode-alist
176 '((t . kimport:text)
177 (outline-mode . kimport:star-outline))
178 "Alist of (major-mode . importation-function) elements.
179 This determines the type of importation done on a file when `kimport:file' is
180 called if the major mode of the import file matches the car of an element in
181 this list. If there is no match, then `kimport:suffix-alist' is checked. If
182 that yields no match, the element in this list whose car is 't is used. It
183 normally does an import of a koutline or text file.
184
185 Each importation-function must take two arguments, a buffer/file to import
186 and a buffer/file into which to insert the imported elements and a third
187 optional argument, CHILDREN-P, which when non-nil means insert imported cells
188 as the initial set of children of the current cell, if any.
189
190 outline-mode - imported as an Emacs outline whose entries begin with
191 asterisks;
192 .kot
193 .kotl - imported as a structured koutline
194
195 all others - imported as text.")
196
197 ;;;###autoload
198 (defvar kimport:suffix-alist
199 '(("\\.otl$". kimport:star-outline)
200 ("\\.aug$" . kimport:aug-post-outline))
201 "Alist of (buffer-name-suffix-regexp . importation-function) elements.
202 This determines the type of importation done on a file when `kimport:file' is
203 called. Each importation-function must take two arguments, a buffer/file to
204 import and a buffer/file into which to insert the imported elements and a
205 third optional argument, CHILDREN-P, which when non-nil means insert imported
206 cells as the initial set of children of the current cell, if any.
207
208 .otl - imported as an Emacs outline whose entries begin with asterisks;
209 .kot
210 .kotl - imported as a structured koutline
211 .aug - imported as an Augment post-numbered outline.")
212
213 ;;; ************************************************************************
214 ;;; You shouldn't need to modify anything below here.
215 ;;; ************************************************************************
216
217 (defun hkey-read-only-bindings ()
218 "Binds Action and Assist Keys in many read-only modes.
219 Uses values of `action-key-read-only' and `assist-key-read-only'. Does
220 nothing if either variable is nil."
221 (if (not (and action-key-read-only assist-key-read-only))
222 nil
223 (if (and (boundp 'Buffer-menu-mode-map)
224 (keymapp Buffer-menu-mode-map))
225 (progn
226 (define-key Buffer-menu-mode-map action-key-read-only 'action-key)
227 (define-key Buffer-menu-mode-map assist-key-read-only
228 'hkey-either)))
229 (if (and (boundp 'calendar-mode-map)
230 (keymapp calendar-mode-map))
231 (progn
232 (define-key calendar-mode-map action-key-read-only 'action-key)
233 (define-key calendar-mode-map assist-key-read-only
234 'hkey-either)))
235 (if (and (boundp 'dired-mode-map)
236 (keymapp dired-mode-map))
237 (progn
238 (define-key dired-mode-map action-key-read-only 'action-key)
239 (define-key dired-mode-map assist-key-read-only
240 'hkey-either)))
241 (if (and (boundp 'gnus-group-mode-map)
242 (keymapp gnus-group-mode-map))
243 (progn
244 (define-key gnus-group-mode-map action-key-read-only 'action-key)
245 (define-key gnus-group-mode-map assist-key-read-only
246 'hkey-either)))
247 (if (and (boundp 'gnus-summary-mode-map)
248 (keymapp gnus-summary-mode-map))
249 (progn
250 (define-key gnus-summary-mode-map action-key-read-only 'action-key)
251 (define-key gnus-summary-mode-map assist-key-read-only
252 'hkey-either)))
253 (if (and (boundp 'Info-mode-map)
254 (keymapp Info-mode-map))
255 (progn
256 (define-key Info-mode-map action-key-read-only 'action-key)
257 (define-key Info-mode-map assist-key-read-only
258 'hkey-either)))
259 (if (and (boundp 'oo-browse-mode-map)
260 (keymapp oo-browse-mode-map))
261 (progn
262 (define-key oo-browse-mode-map action-key-read-only 'action-key)
263 (define-key oo-browse-mode-map assist-key-read-only
264 'hkey-either)))
265 (if (and (boundp 'rmail-mode-map)
266 (keymapp rmail-mode-map))
267 (progn
268 (define-key rmail-mode-map action-key-read-only 'action-key)
269 (define-key rmail-mode-map assist-key-read-only
270 'hkey-either)))
271 (if (and (boundp 'rmail-summary-mode-map)
272 (keymapp rmail-summary-mode-map))
273 (progn
274 (define-key rmail-summary-mode-map action-key-read-only 'action-key)
275 (define-key rmail-summary-mode-map assist-key-read-only
276 'hkey-either)))
277 (if (and (boundp 'unix-apropos-map)
278 (keymapp unix-apropos-map))
279 (progn
280 (define-key unix-apropos-map action-key-read-only 'action-key)
281 (define-key unix-apropos-map assist-key-read-only
282 'hkey-either)))
283 ))
284
285 (hkey-read-only-bindings)
286
287 ;;; ************************************************************************
288 ;;; Setup Hyperbole mouse bindings
289 ;;; ************************************************************************
290
291 (require 'hmouse-key)
292 ;;; The following function call selects between shifted and unshifted Action
293 ;;; and Assist mouse buttons. With no argument or an argument of nil,
294 ;;; shifted buttons are used, and under InfoDock, the middle button also acts
295 ;;; as an Action Key. With a positive number as an argument, use shifted
296 ;;; buttons. With any other integer, use unshifted buttons.
297 (hmouse-shift-buttons)
298
299 ;;; Permits restore of the prior window configuration after any help buffer
300 ;;; is shown by pressing either the Action or Assist Key at the end of the
301 ;;; help buffer. (Help buffer names end with "Help*".)
302 ;;;
303 (setq temp-buffer-show-hook 'hkey-help-show
304 temp-buffer-show-function temp-buffer-show-hook)
305
306 ;;; ************************************************************************
307 ;;; Autoloads
308 ;;; ************************************************************************
309
310 ;;; Menu items could call this function before Info is loaded.
311 (autoload 'Info-goto-node "info" "Jump to specific Info node." t)
312
313 ;;; Hyperbole user interface entry points that trigger loading of the full
314 ;;; Hyperbole system.
315
316 ;; Action type definitions.
317 (autoload 'defact "hsite"
318 "Creates an action TYPE (an unquoted symbol) with PARAMS, described by DOC."
319 nil 'macro)
320 ;; Implicit button type definitions.
321 (autoload 'defib "hsite"
322 "Creates implicit button TYPE (unquoted sym) with PARAMS, described by DOC."
323 nil 'macro)
324
325 (autoload 'ebut:map "hsite" "Map over Hyperbole buffer buttons." nil)
326 (autoload 'hui:ebut-rename "hsite" "Rename a Hyperbole button." t)
327 (autoload 'hyperbole "hsite" "Hyperbole info manager menus." t)
328
329 (autoload 'action-key "hsite"
330 "Context-sensitive Action Key command." t)
331 (autoload 'hkey-help "hsite"
332 "Display help for the Action Key command in current context.
333 With optional ASSIST-FLAG non-nil, display help for the Assist Key command.
334 Returns non-nil iff associated help documentation is found." t)
335 (autoload 'assist-key-help "hsite"
336 "Display help for the Assist Key command in current context." t)
337 (autoload 'hkey-help-hide "hsite"
338 "Restores frame to configuration prior to help buffer display." nil)
339 (autoload 'hkey-help-show "hsite"
340 "Saves prior frame configuration if BUFFER displays help." nil)
341 (autoload 'assist-key "hsite"
342 "Context-sensitive Assist Key command." t)
343 (autoload 'action-mouse-key "hsite"
344 "Context-sensitive Action Mouse Key command." t)
345 (autoload 'assist-mouse-key "hsite"
346 "Context-sensitive Assist Mouse Key command." t)
347 (autoload 'hkey-operate "hsite" "Emulate Hyperbole mouse key drags." t)
348 (autoload 'symset:add "hsite" "Adds ELT to SYMBOL's PROP set." nil)
349 (autoload 'hact "hsite" "Performs action formed from rest of ARGS."
350 nil)
351 (autoload 'actypes::exec-window-cmd "hsite"
352 "Executes an external window-based SHELL-CMD string asynchronously." nil)
353 (autoload 'hpath:absolute-to "hsite"
354 "Make PATH absolute from optional DEFAULT-DIRS." nil)
355 (autoload 'hpath:find "hsite"
356 "Edit file FILENAME, possibly using a special command." t)
357 (autoload 'hpath:find-other-window "hsite"
358 "Edit file FILENAME in other window, possibly using a special command." t)
359
360 ;;; Hyperbole entry points that trigger loading part of the system.
361
362 (autoload 'hypb:functionp "hypb" "Return t iff OBJ is a function." nil)
363
364 ;;; Hyperbole msg reader autoloads.
365 (autoload 'Rmail-init "hrmail" "Initializes Hyperbole Rmail support." t)
366 (autoload 'Mh-init "hmh" "Initializes Hyperbole Mh support." t)
367 (autoload 'Vm-init "hvm" "Initializes Hyperbole Vm support." t)
368 (autoload 'Pm-init "hpm" "Initializes Hyperbole PIEmail support." t)
369 (autoload 'Gnus-init "hgnus" "Initializes Hyperbole Gnus support." t)
370
371 ;;; Hyperbole msg composer autoloads.
372 (autoload 'hmail:compose "hmail"
373 "Compose mail with ADDRESS and evaluation of EXPR." t)
374 (autoload 'hmail:msg-narrow "hmail"
375 "Narrows buffer to displayable part of current message.
376 Its displayable part begins at optional MSG-START and ends at or before MSG-END.")
377
378 ;;; Hyperbole outliner main entry points.
379 (if (not hyperb:kotl-p)
380 nil
381 (autoload 'kfile:find "kfile" "Edit an autonumbered outline." t)
382 (autoload 'kfile:is-p "kfile" "Is an unformatted outline?" nil)
383 (autoload 'kfile:view "kfile"
384 "View an autonumbered outline in read-only mode." t)
385 (autoload 'kotl-mode "kfile" "Autonumbered outlining mode." t)
386 ;;
387 ;; Entry points from Hyperbole Otl/ menu.
388 (autoload 'klink:create "klink" "Insert an implicit link at point." t)
389 (autoload 'kotl-mode:is-p "kfile" "Test if within a Hyperbole outline.")
390 (autoload 'kotl-mode:hide-tree "kfile" "Hide sublevels of current tree." t)
391 (autoload 'kotl-mode:overview "kfile" "Show first line of each cell." t)
392 (autoload 'kotl-mode:show-all "kfile" "Expand all outline cells." t)
393 (autoload 'kotl-mode:show-tree "kfile" "Expand current tree cells." t)
394 (autoload 'kotl-mode:top-cells "kfile" "Hide all but top-level cells." t)
395 ;;
396 ;; Functions required from outline.el library.
397 (autoload 'show-all "outline" "Show all of the text in the buffer." t)
398 ;;
399 (autoload 'kimport:file "kfile" "Import different file types." t)
400 (autoload 'kimport:aug-post-outline "kfile" "Import Augment files." t)
401 (autoload 'kimport:star-outline "kfile" "Import * outline files." t)
402 (autoload 'kimport:text "kfile" "Import text or koutline files." t)
403 )
404
405 ;;; Hyperbole rolodex main entry points.
406 (autoload 'rolo-add "wrolo" "Add an entry to rolodex" t)
407 (autoload 'rolo-display-matches "wrolo" "Redisplay previous rolodex matches" t)
408 (autoload 'rolo-edit "wrolo" "Edit an existing rolodex entry" t)
409 (autoload 'rolo-fgrep "wrolo" "Rolodex string search" t)
410 (autoload 'rolo-grep "wrolo" "Rolodex regexp search" t)
411 (autoload 'rolo-kill "wrolo" "Delete an existing rolodex entry" t)
412 (autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t)
413 (autoload 'rolo-sort "wrolo" "Sort rolodex entries" t)
414 (autoload 'rolo-word "wrolo" "Rolodex string search for a word" t)
415 (autoload 'rolo-yank "wrolo" "Insert a rolodex entry into current buffer" t)
416
417 ;;; Hyperbole Key autoloads.
418 (autoload 'Info-handle-in-note "hmous-info"
419 "Follows Info documentation references.")
420 (autoload 'smart-info "hmous-info" "Follows Info documentation references." t)
421 (autoload 'smart-info-assist "hmous-info"
422 "Follows Info documentation references." t)
423 (autoload 'smart-asm-at-tag-p "hmouse-tag"
424 "Jumps to assembly identifier definitions.")
425 (autoload 'smart-c-at-tag-p "hmouse-tag" "Jumps to C identifier definitions.")
426 (autoload 'smart-lisp-mode-p "hmouse-tag"
427 "Jumps to Lisp identifier definitions.")
428 (autoload 'smart-c++ "hmouse-tag" "Jumps to C++ identifier definitions.")
429 ;; Does nothing unless OO-Browser C++ support has been loaded.
430 (autoload 'smart-c++-oobr "hmouse-tag" "Jumps to C++ identifier definitions.")
431 (autoload 'smart-objc "hmouse-tag" "Jumps to Objective-C identifier definitions.")
432 ;; Does nothing unless OO-Browser Objective-C support has been loaded.
433 (autoload 'smart-objc-oobr "hmouse-tag" "Jumps to Objective-C identifier definitions.")
434 (autoload 'smart-tags-file "hmouse-tag" "Determines nearest etags file.")
435 (autoload 'smart-tags-file-path "hmouse-tag" "Expands a filename from TAGS file.")
436
437 ;;; Window configuration save and restore autoloads.
438 (autoload 'wconfig-add-by-name "wconfig" "Save win config under name." t)
439 (autoload 'wconfig-delete-by-name "wconfig" "Delete win config under name." t)
440 (autoload 'wconfig-restore-by-name "wconfig" "Restore win config under name." t)
441 (autoload 'wconfig-ring-save "wconfig" "Save window-config to ring." t)
442 (autoload 'wconfig-yank-pop "wconfig" "Pop window-config from ring." t)
443 (autoload 'wconfig-delete-pop "wconfig" "Delete window-config from ring." t)
444
445 ;;; ************************************************************************
446 ;;; Auto mode file suffixes
447 ;;; ************************************************************************
448
449 ;;; Invoke kotl-mode for files ending in ".kotl". Also allow ".kot" for DOS
450 ;;; and Windows users.
451 (if hyperb:kotl-p
452 (setq auto-mode-alist (cons '("\\.kotl$\\|\\.kot$" . kotl-mode)
453 auto-mode-alist)))
454
455 ;;; ************************************************************************
456 ;;; MESSAGE SYSTEM SUPPORT CONFIGURATION
457 ;;; ************************************************************************
458
459 ;;; Even if you don't need some of the following hook settings, you might
460 ;;; as well leave them in so that if they ever become useful to you, you
461 ;;; need not reconfigure Hyperbole. These settings do nothing if the
462 ;;; corresponding subsystems are never invoked.
463 ;;;
464 ;;; GNUS USENET news reader/poster support.
465 ;;;
466 (var:append 'gnus-Startup-hook '(Gnus-init))
467 ;;;
468 ;;; Hyperbole mail reader support configuration.
469 ;;;
470 ;; Rmail
471 (var:append 'rmail-mode-hook '(Rmail-init))
472 ;; Mh-e
473 (var:append 'mh-inc-folder-hook '(Mh-init))
474 ;;
475 ;; VM support is based on V5.72 beta of VM. If you have a version of VM
476 ;; earlier than 5.70 beta, you should either upgrade or comment out the
477 ;; following line so that Hyperbole support for VM is not enabled.
478 (var:append 'vm-mode-hooks '(Vm-init))
479 ;;
480 ;; PIEmail
481 (var:append 'pm-hook '(Pm-init))
482 ;;;
483 ;;; Hyperbole mail composer support configuration.
484 ;;;
485 (var:append 'mail-mode-hook '((lambda () (require 'hsmail))))
486 (var:append 'mh-letter-mode-hook '((lambda () (require 'hsmail))))
487 (var:append 'vm-mail-mode-hook '((lambda () (require 'hsmail))))
488
489 ;;; ************************************************************************
490 ;;; Frame function aliases.
491 ;;; ************************************************************************
492 ;; Create all needed 'frame-' aliases for all 'screen-' functions, e.g.
493 ;; screen-width.
494 (if (fboundp 'selected-frame)
495 nil
496 (fset 'selected-frame 'selected-screen)
497 (mapcar
498 (function (lambda (func-name)
499 (or (fboundp (intern-soft (concat "frame" func-name)))
500 (fset (intern (concat "frame" func-name))
501 (intern-soft (concat "screen" func-name))))))
502 '("-width" "-height")))
503
504 (provide 'hyperbole)