;;!emacs
;;
;; FILE:         hsite.el
;; SUMMARY:      Site-specific setup for Hyperbole
;; USAGE:        GNU Emacs Lisp Library
;;
;; AUTHOR:       Bob Weiner
;; ORG:          Brown U.
;;
;; ORIG-DATE:    15-Apr-91 at 00:48:49
;; LAST-MOD:     21-May-93 at 19:17:40 by Bob Weiner
;;
;; This file is part of Hyperbole.
;; 
;; Copyright (C) 1991, 1993, Brown University, Providence, RI
;; Developed with support from Motorola Inc.
;; 
;; Permission to use, modify and redistribute this software and its
;; documentation for any purpose other than its incorporation into a
;; commercial product is hereby granted without fee.  A distribution fee
;; may be charged with any redistribution.  Any distribution requires
;; that the above copyright notice appear in all copies, that both that
;; copyright notice and this permission notice appear in supporting
;; documentation, and that neither the name of Brown University nor the
;; author's name be used in advertising or publicity pertaining to
;; distribution of the software without specific, written prior permission.
;; 
;; Brown University makes no representations about the suitability of this
;; software for any purpose.  It is provided "as is" without express or
;; implied warranty.
;;
;;
;; DESCRIPTION:  
;;
;;   TO INSTALL:
;;
;;   In the following instructions <HYP-DIR> refers to the full directory
;;   path in which the Hyperbole code is kept.  Substitute your own path.
;;
;;   The following line sets up Hyperbole for autoloading so that its code is
;;   actually not loaded until it is invoked.  Add it without the semicolon
;;   prefix to your site Emacs "lisp/default.el" file or wherever you add
;;   Emacs Lisp library load or autoload calls (and remember to byte-compile
;;   the file):
;;
;;      (load "<HYP-DIR>/hyperbole")
;;
;;   Alternatively, If you want Hyperbole to always completely load upon
;;   startup, add the following lines instead: 
;;
;;      (load "<HYP-DIR>/hyperbole")
;;      (load "<HYP-DIR>/hsite")
;;
;;   in your ~~/.emacs" file for you personally or in "lisp/default.el"
;;   for your whole site.
;;
;;   Copy "hsite-ex.el" to "hsite.el".
;;   Read through ALL of the comments throughout the whole "hsite.el" file
;;   and modify it as desired.  The only required change you must make
;;   is to substitute your chosen path for <HYP-DIR> in the uncommented
;;   line in which it appears.
;;   
;;   The "hsite.el" may be byte-compiled if you like but normally
;;   it is not.
;;
;;   Be sure to have users load any personal mail/news initializations
;;   before they load this file if any of Hyperbole's mail or news
;;   support features are enabled either herein or within their personal
;;   Hyperbole initializations.  Otherwise, the mail/news support may
;;   not be configured properly.
;;
;; DESCRIP-END.

;; ************************************************************************
;; Read the comments and modify as desired.
;; ************************************************************************

(message "Initializing Hyperbole...")

;;; 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 'hui:menu)
    (define-key help-map "h" 'hui:menu))

;;; 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.
;;;
(or (global-key-binding "\M-o")
    (where-is-internal 'smart-key-operate)
    (global-set-key "\M-o" 'smart-key-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))

;;; Provides a site standard way to easily switch between the Smart Key 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 'sm-mouse-toggle-bindings)
    (global-set-key "\C-ct" 'sm-mouse-toggle-bindings))

(defun smart-key-either (arg)
  "Executes `smart-key' or with non-nil ARG executes `smart-key-meta'."
  (interactive "P")
  (if arg (smart-key-meta) (smart-key)))

;;; A value of t for 'smart-key-init' below will cause the Smart 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 'smart-key-init) (setq smart-key-init t))
(and smart-key-init
     (not (global-key-binding "\M-\C-m"))
     (global-set-key "\M-\C-m" 'smart-key-either))
;;
;; Bind a key, normally, {C-h S}, for context-sensitive smart-key help.
(and smart-key-init
     (not (where-is-internal 'smart-key-help))
     (define-key help-map "S" 'smart-key-help))

(defvar smart-scroll-proportional nil
  "*Non-nil value makes smart key end-of-line scroll relative to current line.
Primary smart key moves current line to top of window.  Secondary smart key
moves current line to bottom of window.  Repeated smart key presses then
scroll up/down a windowful.
Nil value instead ignores current line and scrolls up or down a windowful.")

;;;
;;; Smart Key bindings for many non-edit modes.
;;; Set both to nil if unwanted.
;;;
(defvar smart-key-read-only "\C-m"
  "Local Smart Key binding for special read-only modes.")
(defvar smart-key-meta-read-only "\M-\C-m"
  "Local secondary Smart Key binding for special read-only modes.")

;;; Substitute the directory in which you stored the Hyperbole code
;;; for <HYP-DIR> below.
;;;
(if (boundp 'hyperb:dir)
    nil
  (defconst hyperb:dir (file-name-as-directory "<HYP-DIR>")
    "Directory where Hyperbole code and doc files are kept."))
(let (newpath)
  (or (featurep 'set) (load (expand-file-name "set" hyperb:dir)))
  (if (setq newpath (set:add hyperb:dir load-path))
      (setq load-path newpath)))

;;; Support mouse handling under GNU Emacs V19.
;;;
(defvar hyperb:emacs19-p
  (if (string-match "^19\\." emacs-version)
      emacs-version)
  "GNU Emacs 19 version string.")

;;; Support button highlighting and flashing under Lucid Emacs.
;;;
(defvar hyperb:lemacs-p
  (let ((case-fold-search t))
    (if (string-match "Lucid" emacs-version)
	emacs-version))
  "Lucid Emacs version string.")

(if hyperb:lemacs-p
    (progn
      (require 'hui-le-but)
      (fset 'hui:but-flash 'le:but-flash)
      ;; Substitute for the nil argument below a valid X color name with
      ;; which to highlight buttons if the default highlighting does not
      ;; appeal to you. See "hui-le-but.el" for how this works.
      (le:cycle-but-color nil)
      ;; If you find that the Hyperbole button flash time is too slow
      ;; or too fast, adjust it here.
      (defvar le:but-flash-time 1000
	"Machine specific val for empty loop counter, Lucid Emacs but flash delay.")
      )
  (defun hui:but-flash ())
  )

;;; Support button highlighting and flashing under Epoch.
;;;
(defvar hyperb:epoch-p
  (if (boundp 'epoch::version)
      (if (string< epoch::version "Epoch 4") "V3" "V4"))
  "Simplified Epoch version string, e.g. \"V4\", else nil.")

(if (and hyperb:epoch-p (string= hyperb:epoch-p "V4"))
    (progn
      (require 'hui-epV4-b)
      (fset 'hui:but-flash 'ep:but-flash)
      ;; Substitute for the nil argument below a valid X color name with
      ;; which to highlight buttons if the default highlighting does not
      ;; appeal to you. See the hui-epV* files for how this works.
      (ep:cycle-but-color nil)
      ;; If you use Epoch and find that the Hyperbole button flash time is
      ;; too slow or too fast, adjust it here.
      (defvar ep:but-flash-time 1000
	"Machine specific val for empty loop counter, Epoch but flash delay.")
      )
  (defun hui:but-flash ())
  )

;;; Support for encapsulations of any of these external systems may be
;;; enabled here.  You should be familiar with the external system before
;;; you try to use the Hyperbole support for it.
;;; Possible system encapsulations to include within the innermost set of
;;; parentheses are:
;;;   hsys-hbase hsys-wais hsys-www
;;;
(setq hibtypes:begin-load-hook
      (list (function (lambda () (mapcar 'require '())))))

;;; Support for online library document id references is loaded here but
;;; requires some additional configuration before use.  See the DESCRIPTION
;;; section in "hib-doc-id.el" for complete installation and use information.
;;;
(setq hibtypes:end-load-hook
      (list (function (lambda () (mapcar 'require '(hib-doc-id))))))

;;; This call loads the whole Hyperbole system.
;;; You may want to look at this file just to see what it does.
;;;
(require 'hinit)
;;;
;;; This call initializes the Hyperbole system for use.
;;;
(hyperb:init)

;;; `hyperb:window-system' variable from "hmouse-key.el" must be defined
;;; prior to this variable definition.
;;;
(defvar hpath:find-alist
  (cdr (assoc hyperb:window-system
		  '(("emacs19" . nil)       ; GNU Emacs V19 under X
		    ("lemacs"  . nil)       ; Lucid Emacs under X
		    ("xterm"   . nil)       ; GNU Emacs V18 under X
		    ("epoch"   . nil)       ; UofI Epoch under X
		    ("sun"     . nil)       ; SunView
		    ("next"    .
		     (("\\.\\(adaptor\\|app\\|bshlf\\|clr\\|concur\\|create\\|diagram\\|dp\\|e?ps\\|gif\\|locus\\|Mesa\\|nib\\|project\\|sense\\|tiff\\|tree\\)$" . "open")))        ; NEXTSTEP
		    ("apollo"  . nil)       ; Display Manager
		    )))
  "*Alist of (FILENAME-REGEXP . EDIT-PROGRAM) elements for using window system
dependent external programs to edit/display particular file types.")

;;; This variable substitutes from its list of Emacs Lisp variables within
;;; any Hyperbole link button pathnames which match the value of a variable.
;;; Hyperbole then replaces the variables with a matching value when the link
;;; is resolved.  This permits sharing of links over wide areas, where the
;;; variable values may differ between link creator and link activator.
;;;
(defvar hpath:variables
  '(hyperb:dir Info-directory Info-directory-list sm-directory load-path exec-path)
  "*List of Emacs Lisp variable names to substitute in link paths which match to their values.
Each variable value, if bound, must be either a pathname or a list of pathnames.")

;;; 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.
;;;
(var:append 'rmail-mode-hook    '(Rmail-init))
(var:append 'mh-inc-folder-hook '(Mh-init))
(var:append 'vm-mode-hooks      '(Vm-init))
(var:append 'pm-hook            '(Pm-init))

;;; Enables Smart Key mouse setup.
(sm-mouse-setup)

;;; Permits restore of screen configuration after any help buffer is shown
;;; by pressing either Smart Key at the end of the help buffer.  (Help buffer
;;; names end with "Help*".
;;;
(setq temp-buffer-show-hook 'smart-key-help-show
      temp-buffer-show-function temp-buffer-show-hook)

;;; Key bindings for screen save/restore ring, like kill-ring.
;;; {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))

;;; This may be removed if Hyperbole variables are never used in file local
;;; variable lists or if it causes a conflict with any local variable lists you
;;; use.  See the source file for more details.
;;;
(require 'hlvar)

(defun hypb:read-only-smart-keys ()
  "Binds smart keys in many read-only modes.
Uses values of `smart-key-read-only' and `smart-key-meta-read-only'.  Does
nothing if either variable is nil."
  (if (not (and smart-key-read-only smart-key-meta-read-only))
      nil
    (if (and (boundp 'Buffer-menu-mode-map)
	     (keymapp Buffer-menu-mode-map))
	(progn
	  (define-key Buffer-menu-mode-map smart-key-read-only 'smart-key)
	  (define-key Buffer-menu-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'calendar-mode-map)
	     (keymapp calendar-mode-map))
	(progn
	  (define-key calendar-mode-map smart-key-read-only 'smart-key)
	  (define-key calendar-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'dired-mode-map)
	     (keymapp dired-mode-map))
	(progn
	  (define-key dired-mode-map smart-key-read-only 'smart-dired)
	  (define-key dired-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'gnus-Group-mode-map)
	     (keymapp gnus-Group-mode-map))
	(progn
	  (define-key gnus-Group-mode-map smart-key-read-only 'smart-key)
	  (define-key gnus-Group-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'gnus-Subject-mode-map)
	     (keymapp gnus-Subject-mode-map))
	(progn
	  (define-key gnus-Subject-mode-map smart-key-read-only 'smart-key)
	  (define-key gnus-Subject-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'Info-mode-map)
	     (keymapp Info-mode-map))
	(progn
	  (define-key Info-mode-map smart-key-read-only 'smart-key)
	  (define-key Info-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'oo-browse-mode-map)
	     (keymapp oo-browse-mode-map))
	(progn 
	  (define-key oo-browse-mode-map smart-key-read-only 'smart-key)
	  (define-key oo-browse-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'rmail-mode-map)
	     (keymapp rmail-mode-map))
	(progn
	  (define-key rmail-mode-map smart-key-read-only 'smart-key)
	  (define-key rmail-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'rmail-summary-mode-map)
	     (keymapp rmail-summary-mode-map))
	(progn
	  (define-key rmail-summary-mode-map smart-key-read-only 'smart-key)
	  (define-key rmail-summary-mode-map smart-key-meta-read-only
	    'smart-key-either)))
    (if (and (boundp 'unix-apropos-map)
	     (keymapp unix-apropos-map))
	(progn
	  (define-key unix-apropos-map smart-key-read-only 'smart-key)
	  (define-key unix-apropos-map smart-key-meta-read-only
	    'smart-key-either)))
    ))

(hypb:read-only-smart-keys)

(provide 'hsite)

(message "Hyperbole is ready for action.")
