Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/hyperbole/hyperbole.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,504 @@ +;;!emacs +;; +;; LCD-ENTRY: See "hversion.el". +;; +;; FILE: hyperbole.el +;; SUMMARY: Sets up Hyperbole for autoloading and use. +;; USAGE: GNU Emacs Lisp Library +;; KEYWORDS: hypermedia +;; +;; AUTHOR: Bob Weiner +;; ORG: Motorola, Inc., PWDG +;; +;; ORIG-DATE: 6-Oct-92 at 11:52:51 +;; LAST-MOD: 3-Nov-95 at 23:14:52 by Bob Weiner +;; +;; This file is part of Hyperbole. +;; Available for use and distribution under the same terms as GNU Emacs. +;; +;; Copyright (C) 1992-1995, Free Software Foundation, Inc. +;; Developed with support from Motorola Inc. +;; +;; DESCRIPTION: +;; +;; See the "README" file for installation instructions. +;; +;; There is no need to manually edit this file unless there are specific +;; customizations you would like to make, such as whether the Hyperbole +;; mouse buttons are placed on shifted or unshifted mouse buttons. +;; (See the call of the function, hmouse-shift-buttons, below.) +;; +;; Other site-specific customizations belong in "hsite.el" which is created +;; from "hsite-ex.el" by the person who installs Hyperbole at your site. +;; +;; DESCRIP-END. + +;;; ************************************************************************ +;;; Hyperbole directory setting +;;; ************************************************************************ + +;; Defines hyperb:window-system, hyperb:kotl-p and +;; (hyperb:path-being-loaded), which are used below. +;; The Hyperbole distribution directory must either already be in +;; load-path or an explicit load of "hversion" must have been +;; done already or else the following line will fail to load hversion. +;; This is all documented in the Hyperbole installation instructions. +(require 'hversion) + +;; Reinitialize hyperb:dir on reload if initialization failed for any reason. +(and (boundp 'hyperb:dir) (null hyperb:dir) (makunbound 'hyperb:dir)) + +(defvar hyperb:dir (if (fboundp 'backtrace-frame) (hyperb:path-being-loaded)) + "Directory where the Hyperbole executable code is kept. +It must end with a directory separator character.") +(if (stringp hyperb:dir) + (setq hyperb:dir (file-name-directory hyperb:dir)) + (error + "(hyperbole.el): Failed to set hyperb:dir. Try setting it manually.")) + +;;; ************************************************************************ +;;; Other required Elisp libraries +;;; ************************************************************************ + +(require 'set (expand-file-name "set" hyperb:dir)) + +;; Add hyperb:dir and kotl subdirectory to load-path so other +;; Hyperbole libraries can be found. +(setq load-path (set:add hyperb:dir load-path)) +(if hyperb:kotl-p + (setq load-path (set:add (expand-file-name "kotl/" hyperb:dir) load-path))) + +(require 'hvar) ;; Defines var:append function. + +;;; ************************************************************************ +;;; Public key bindings +;;; ************************************************************************ + +;;; Setup so Hyperbole can be autoloaded from a key. +;;; Choose a key on which to place the Hyperbole menus. +;;; For most people this key binding will work and will be equivalent +;;; to {C-h h}. +;;; +(or (where-is-internal 'hyperbole) + (where-is-internal 'hui:menu) + (define-key help-map "h" 'hyperbole)) + +;;; Provides a site standard way of emulating most Hyperbole mouse drag +;;; commands from the keyboard. This is most useful for rapidly creating +;;; Hyperbole link buttons from the keyboard without invoking the Hyperbole +;;; menu. Only works if Emacs is run under a window system. +;;; +(or (not hyperb:window-system) + (global-key-binding "\M-o") + (where-is-internal 'hkey-operate) + (global-set-key "\M-o" 'hkey-operate)) + +;;; Provides a site standard way of performing explicit button +;;; renames without invoking the Hyperbole menu. +;;; +(or (global-key-binding "\C-c\C-r") + (where-is-internal 'hui:ebut-rename) + (global-set-key "\C-c\C-r" 'hui:ebut-rename)) + +;;; The following operations are now available through the Hyperbole Win/ +;;; menu. In earlier versions of Hyperbole, each of these operations had its +;;; own keybindings. Uncomment the following code lines if you still want +;;; to use those key bindings. +;;; Key bindings for window configuration save/restore ring, like kill-ring +;;; except holds the configuration of windows within a frame. +;;; {C-x 4 w} to save config; {C-x 4 y} to restore successive +;;; saves; {C-x 4 DEL} to delete successive saves. +;;; +;; (or (global-key-binding "\C-x4w") +;; (global-set-key "\C-x4w" 'wconfig-ring-save)) +;; (or (global-key-binding "\C-x4y") +;; (global-set-key "\C-x4y" 'wconfig-yank-pop)) +;; (or (global-key-binding "\C-x4\177") +;; (global-set-key "\C-x4\177" 'wconfig-delete-pop)) + +;;; Provides a site standard way to easily switch between the Hyperbole mouse +;;; bindings and a set of personal mouse bindings. You may instead show +;;; users how to bind this to a key via 'hyperb:init-hook' (see +;;; Hyperbole Manual). +;;; +(or (global-key-binding "\C-ct") + (where-is-internal 'hmouse-toggle-bindings) + (global-set-key "\C-ct" 'hmouse-toggle-bindings)) + +(defun hkey-either (arg) + "Executes `action-key' or with non-nil ARG executes `assist-key'." + (interactive "P") + (if arg (assist-key) (action-key))) + +;;; A value of t for 'hkey-init' below will cause the Hyperbole +;;; context-sensitive keys to be bound to keyboard keys, in addition to any +;;; mouse key bindings. Comment it out or set it to nil if you don't want +;;; these bindings. Or change the bindings in the succeeding lines. +;;; +(or (boundp 'hkey-init) (setq hkey-init t)) +(and hkey-init + (not (global-key-binding "\M-\C-m")) + (global-set-key "\M-\C-m" 'hkey-either)) +;; +;; Bind a key, {C-h A}, for Action Key help and {C-u C-h A} for Assist key +;; help. +(and hkey-init + (not (where-is-internal 'hkey-help)) + (define-key help-map "A" 'hkey-help)) + +;;; +;;; Hyperbole key bindings for many non-edit modes. +;;; Set both to nil if unwanted. +;;; +(defvar action-key-read-only "\C-m" + "Local Action Key binding for special read-only modes.") +(defvar assist-key-read-only "\M-\C-m" + "Local Assist Key binding for special read-only modes.") + +;;; ************************************************************************ +;;; URL Browsing +;;; ************************************************************************ + +;;;###autoload +(defvar action-key-url-function 'w3-fetch + "Value is a function of one argument, a url, which displays the url referent. +Possible values are: + w3-fetch - display using the W3 Emacs web browser; + highlight-headers-follow-url-netscape - display in Netscape; + highlight-headers-follow-url-mosaic - display in Mosaic.") + +;;; ************************************************************************ +;;; Koutliner mode and file suffix importation settings. +;;; ************************************************************************ + +;;;###autoload +(defvar kimport:mode-alist + '((t . kimport:text) + (outline-mode . kimport:star-outline)) + "Alist of (major-mode . importation-function) elements. +This determines the type of importation done on a file when `kimport:file' is +called if the major mode of the import file matches the car of an element in +this list. If there is no match, then `kimport:suffix-alist' is checked. If +that yields no match, the element in this list whose car is 't is used. It +normally does an import of a koutline or text file. + +Each importation-function must take two arguments, a buffer/file to import +and a buffer/file into which to insert the imported elements and a third +optional argument, CHILDREN-P, which when non-nil means insert imported cells +as the initial set of children of the current cell, if any. + + outline-mode - imported as an Emacs outline whose entries begin with + asterisks; + .kot + .kotl - imported as a structured koutline + + all others - imported as text.") + +;;;###autoload +(defvar kimport:suffix-alist + '(("\\.otl$". kimport:star-outline) + ("\\.aug$" . kimport:aug-post-outline)) + "Alist of (buffer-name-suffix-regexp . importation-function) elements. +This determines the type of importation done on a file when `kimport:file' is +called. Each importation-function must take two arguments, a buffer/file to +import and a buffer/file into which to insert the imported elements and a +third optional argument, CHILDREN-P, which when non-nil means insert imported +cells as the initial set of children of the current cell, if any. + + .otl - imported as an Emacs outline whose entries begin with asterisks; + .kot + .kotl - imported as a structured koutline + .aug - imported as an Augment post-numbered outline.") + +;;; ************************************************************************ +;;; You shouldn't need to modify anything below here. +;;; ************************************************************************ + +(defun hkey-read-only-bindings () + "Binds Action and Assist Keys in many read-only modes. +Uses values of `action-key-read-only' and `assist-key-read-only'. Does +nothing if either variable is nil." + (if (not (and action-key-read-only assist-key-read-only)) + nil + (if (and (boundp 'Buffer-menu-mode-map) + (keymapp Buffer-menu-mode-map)) + (progn + (define-key Buffer-menu-mode-map action-key-read-only 'action-key) + (define-key Buffer-menu-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'calendar-mode-map) + (keymapp calendar-mode-map)) + (progn + (define-key calendar-mode-map action-key-read-only 'action-key) + (define-key calendar-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'dired-mode-map) + (keymapp dired-mode-map)) + (progn + (define-key dired-mode-map action-key-read-only 'action-key) + (define-key dired-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'gnus-group-mode-map) + (keymapp gnus-group-mode-map)) + (progn + (define-key gnus-group-mode-map action-key-read-only 'action-key) + (define-key gnus-group-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'gnus-summary-mode-map) + (keymapp gnus-summary-mode-map)) + (progn + (define-key gnus-summary-mode-map action-key-read-only 'action-key) + (define-key gnus-summary-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'Info-mode-map) + (keymapp Info-mode-map)) + (progn + (define-key Info-mode-map action-key-read-only 'action-key) + (define-key Info-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'oo-browse-mode-map) + (keymapp oo-browse-mode-map)) + (progn + (define-key oo-browse-mode-map action-key-read-only 'action-key) + (define-key oo-browse-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'rmail-mode-map) + (keymapp rmail-mode-map)) + (progn + (define-key rmail-mode-map action-key-read-only 'action-key) + (define-key rmail-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'rmail-summary-mode-map) + (keymapp rmail-summary-mode-map)) + (progn + (define-key rmail-summary-mode-map action-key-read-only 'action-key) + (define-key rmail-summary-mode-map assist-key-read-only + 'hkey-either))) + (if (and (boundp 'unix-apropos-map) + (keymapp unix-apropos-map)) + (progn + (define-key unix-apropos-map action-key-read-only 'action-key) + (define-key unix-apropos-map assist-key-read-only + 'hkey-either))) + )) + +(hkey-read-only-bindings) + +;;; ************************************************************************ +;;; Setup Hyperbole mouse bindings +;;; ************************************************************************ + +(require 'hmouse-key) +;;; The following function call selects between shifted and unshifted Action +;;; and Assist mouse buttons. With no argument or an argument of nil, +;;; shifted buttons are used, and under InfoDock, the middle button also acts +;;; as an Action Key. With a positive number as an argument, use shifted +;;; buttons. With any other integer, use unshifted buttons. +(hmouse-shift-buttons) + +;;; Permits restore of the prior window configuration after any help buffer +;;; is shown by pressing either the Action or Assist Key at the end of the +;;; help buffer. (Help buffer names end with "Help*".) +;;; +(setq temp-buffer-show-hook 'hkey-help-show + temp-buffer-show-function temp-buffer-show-hook) + +;;; ************************************************************************ +;;; Autoloads +;;; ************************************************************************ + +;;; Menu items could call this function before Info is loaded. +(autoload 'Info-goto-node "info" "Jump to specific Info node." t) + +;;; Hyperbole user interface entry points that trigger loading of the full +;;; Hyperbole system. + +;; Action type definitions. +(autoload 'defact "hsite" + "Creates an action TYPE (an unquoted symbol) with PARAMS, described by DOC." + nil 'macro) +;; Implicit button type definitions. +(autoload 'defib "hsite" + "Creates implicit button TYPE (unquoted sym) with PARAMS, described by DOC." + nil 'macro) + +(autoload 'ebut:map "hsite" "Map over Hyperbole buffer buttons." nil) +(autoload 'hui:ebut-rename "hsite" "Rename a Hyperbole button." t) +(autoload 'hyperbole "hsite" "Hyperbole info manager menus." t) + +(autoload 'action-key "hsite" + "Context-sensitive Action Key command." t) +(autoload 'hkey-help "hsite" + "Display help for the Action Key command in current context. +With optional ASSIST-FLAG non-nil, display help for the Assist Key command. +Returns non-nil iff associated help documentation is found." t) +(autoload 'assist-key-help "hsite" + "Display help for the Assist Key command in current context." t) +(autoload 'hkey-help-hide "hsite" + "Restores frame to configuration prior to help buffer display." nil) +(autoload 'hkey-help-show "hsite" + "Saves prior frame configuration if BUFFER displays help." nil) +(autoload 'assist-key "hsite" + "Context-sensitive Assist Key command." t) +(autoload 'action-mouse-key "hsite" + "Context-sensitive Action Mouse Key command." t) +(autoload 'assist-mouse-key "hsite" + "Context-sensitive Assist Mouse Key command." t) +(autoload 'hkey-operate "hsite" "Emulate Hyperbole mouse key drags." t) +(autoload 'symset:add "hsite" "Adds ELT to SYMBOL's PROP set." nil) +(autoload 'hact "hsite" "Performs action formed from rest of ARGS." + nil) +(autoload 'actypes::exec-window-cmd "hsite" + "Executes an external window-based SHELL-CMD string asynchronously." nil) +(autoload 'hpath:absolute-to "hsite" + "Make PATH absolute from optional DEFAULT-DIRS." nil) +(autoload 'hpath:find "hsite" + "Edit file FILENAME, possibly using a special command." t) +(autoload 'hpath:find-other-window "hsite" + "Edit file FILENAME in other window, possibly using a special command." t) + +;;; Hyperbole entry points that trigger loading part of the system. + +(autoload 'hypb:functionp "hypb" "Return t iff OBJ is a function." nil) + +;;; Hyperbole msg reader autoloads. +(autoload 'Rmail-init "hrmail" "Initializes Hyperbole Rmail support." t) +(autoload 'Mh-init "hmh" "Initializes Hyperbole Mh support." t) +(autoload 'Vm-init "hvm" "Initializes Hyperbole Vm support." t) +(autoload 'Pm-init "hpm" "Initializes Hyperbole PIEmail support." t) +(autoload 'Gnus-init "hgnus" "Initializes Hyperbole Gnus support." t) + +;;; Hyperbole msg composer autoloads. +(autoload 'hmail:compose "hmail" + "Compose mail with ADDRESS and evaluation of EXPR." t) +(autoload 'hmail:msg-narrow "hmail" + "Narrows buffer to displayable part of current message. +Its displayable part begins at optional MSG-START and ends at or before MSG-END.") + +;;; Hyperbole outliner main entry points. +(if (not hyperb:kotl-p) + nil + (autoload 'kfile:find "kfile" "Edit an autonumbered outline." t) + (autoload 'kfile:is-p "kfile" "Is an unformatted outline?" nil) + (autoload 'kfile:view "kfile" + "View an autonumbered outline in read-only mode." t) + (autoload 'kotl-mode "kfile" "Autonumbered outlining mode." t) + ;; + ;; Entry points from Hyperbole Otl/ menu. + (autoload 'klink:create "klink" "Insert an implicit link at point." t) + (autoload 'kotl-mode:is-p "kfile" "Test if within a Hyperbole outline.") + (autoload 'kotl-mode:hide-tree "kfile" "Hide sublevels of current tree." t) + (autoload 'kotl-mode:overview "kfile" "Show first line of each cell." t) + (autoload 'kotl-mode:show-all "kfile" "Expand all outline cells." t) + (autoload 'kotl-mode:show-tree "kfile" "Expand current tree cells." t) + (autoload 'kotl-mode:top-cells "kfile" "Hide all but top-level cells." t) + ;; + ;; Functions required from outline.el library. + (autoload 'show-all "outline" "Show all of the text in the buffer." t) + ;; + (autoload 'kimport:file "kfile" "Import different file types." t) + (autoload 'kimport:aug-post-outline "kfile" "Import Augment files." t) + (autoload 'kimport:star-outline "kfile" "Import * outline files." t) + (autoload 'kimport:text "kfile" "Import text or koutline files." t) + ) + +;;; Hyperbole rolodex main entry points. +(autoload 'rolo-add "wrolo" "Add an entry to rolodex" t) +(autoload 'rolo-display-matches "wrolo" "Redisplay previous rolodex matches" t) +(autoload 'rolo-edit "wrolo" "Edit an existing rolodex entry" t) +(autoload 'rolo-fgrep "wrolo" "Rolodex string search" t) +(autoload 'rolo-grep "wrolo" "Rolodex regexp search" t) +(autoload 'rolo-kill "wrolo" "Delete an existing rolodex entry" t) +(autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t) +(autoload 'rolo-sort "wrolo" "Sort rolodex entries" t) +(autoload 'rolo-word "wrolo" "Rolodex string search for a word" t) +(autoload 'rolo-yank "wrolo" "Insert a rolodex entry into current buffer" t) + +;;; Hyperbole Key autoloads. +(autoload 'Info-handle-in-note "hmous-info" + "Follows Info documentation references.") +(autoload 'smart-info "hmous-info" "Follows Info documentation references." t) +(autoload 'smart-info-assist "hmous-info" + "Follows Info documentation references." t) +(autoload 'smart-asm-at-tag-p "hmouse-tag" + "Jumps to assembly identifier definitions.") +(autoload 'smart-c-at-tag-p "hmouse-tag" "Jumps to C identifier definitions.") +(autoload 'smart-lisp-mode-p "hmouse-tag" + "Jumps to Lisp identifier definitions.") +(autoload 'smart-c++ "hmouse-tag" "Jumps to C++ identifier definitions.") +;; Does nothing unless OO-Browser C++ support has been loaded. +(autoload 'smart-c++-oobr "hmouse-tag" "Jumps to C++ identifier definitions.") +(autoload 'smart-objc "hmouse-tag" "Jumps to Objective-C identifier definitions.") +;; Does nothing unless OO-Browser Objective-C support has been loaded. +(autoload 'smart-objc-oobr "hmouse-tag" "Jumps to Objective-C identifier definitions.") +(autoload 'smart-tags-file "hmouse-tag" "Determines nearest etags file.") +(autoload 'smart-tags-file-path "hmouse-tag" "Expands a filename from TAGS file.") + +;;; Window configuration save and restore autoloads. +(autoload 'wconfig-add-by-name "wconfig" "Save win config under name." t) +(autoload 'wconfig-delete-by-name "wconfig" "Delete win config under name." t) +(autoload 'wconfig-restore-by-name "wconfig" "Restore win config under name." t) +(autoload 'wconfig-ring-save "wconfig" "Save window-config to ring." t) +(autoload 'wconfig-yank-pop "wconfig" "Pop window-config from ring." t) +(autoload 'wconfig-delete-pop "wconfig" "Delete window-config from ring." t) + +;;; ************************************************************************ +;;; Auto mode file suffixes +;;; ************************************************************************ + +;;; Invoke kotl-mode for files ending in ".kotl". Also allow ".kot" for DOS +;;; and Windows users. +(if hyperb:kotl-p + (setq auto-mode-alist (cons '("\\.kotl$\\|\\.kot$" . kotl-mode) + auto-mode-alist))) + +;;; ************************************************************************ +;;; MESSAGE SYSTEM SUPPORT CONFIGURATION +;;; ************************************************************************ + +;;; Even if you don't need some of the following hook settings, you might +;;; as well leave them in so that if they ever become useful to you, you +;;; need not reconfigure Hyperbole. These settings do nothing if the +;;; corresponding subsystems are never invoked. +;;; +;;; GNUS USENET news reader/poster support. +;;; +(var:append 'gnus-Startup-hook '(Gnus-init)) +;;; +;;; Hyperbole mail reader support configuration. +;;; +;; Rmail +(var:append 'rmail-mode-hook '(Rmail-init)) +;; Mh-e +(var:append 'mh-inc-folder-hook '(Mh-init)) +;; +;; VM support is based on V5.72 beta of VM. If you have a version of VM +;; earlier than 5.70 beta, you should either upgrade or comment out the +;; following line so that Hyperbole support for VM is not enabled. +(var:append 'vm-mode-hooks '(Vm-init)) +;; +;; PIEmail +(var:append 'pm-hook '(Pm-init)) +;;; +;;; Hyperbole mail composer support configuration. +;;; +(var:append 'mail-mode-hook '((lambda () (require 'hsmail)))) +(var:append 'mh-letter-mode-hook '((lambda () (require 'hsmail)))) +(var:append 'vm-mail-mode-hook '((lambda () (require 'hsmail)))) + +;;; ************************************************************************ +;;; Frame function aliases. +;;; ************************************************************************ +;; Create all needed 'frame-' aliases for all 'screen-' functions, e.g. +;; screen-width. +(if (fboundp 'selected-frame) + nil + (fset 'selected-frame 'selected-screen) + (mapcar + (function (lambda (func-name) + (or (fboundp (intern-soft (concat "frame" func-name))) + (fset (intern (concat "frame" func-name)) + (intern-soft (concat "screen" func-name)))))) + '("-width" "-height"))) + +(provide 'hyperbole)