cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hinit.el

   1 ;;; hinit.el --- Standard initializations for Hyperbole hypertext system.
   2
   3 ;; Copyright (C) 1991-1995, 2004, 2006 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;;;
  32 ;;; Public variables
  33 ;;;
  34
  35 (defvar   hyperb:host-domain nil
  36   "<@domain-name> for current host.  Set automatically by 'hyperb:init'.")
  37
  38 ;;;
  39 ;;; Other required Elisp libraries
  40 ;;;
  41
  42 (require 'hvar)
  43
  44 (mapcar 'require '(hui-mouse hypb hui hui-mini hbmap hibtypes))
  45
  46 ;;;
  47 ;;; Public functions
  48 ;;;
  49
  50 (if (not (fboundp 'br-in-browser))
  51     ;; Then the OO-Browser is not loaded, so we can never be within the
  52     ;; browser.  Define this as a dummy function that always returns nil
  53     ;; until the OO-Browser is ever loaded.
  54     (defun br-in-browser ()
  55       "Always returns nil since the OO-Browser is not loaded."
  56       nil))
  57
  58 (defun hyperb:init ()
  59   "Standard configuration routine for Hyperbole."
  60   (interactive)
  61   (run-hooks 'hyperb:init-hook)
  62   (hyperb:check-dir-user)
  63   (or hyperb:host-domain (setq hyperb:host-domain (hypb:domain-name)))
  64   (hyperb:act-set)
  65   ;;
  66   ;; Save button attribute file whenever same dir file is saved and
  67   ;; 'ebut:hattr-save' is non-nil.
  68   ;;
  69   (var:append 'write-file-hooks '(hattr:save))
  70   ;;
  71   (if hyperbole-on-menubar (hyperb:init-menubar)))
  72
  73 (defun hyperb:init-menubar ()
  74   "Add a pulldown menu for Hyperbole, if appropriate."
  75   (and hyperb:window-system
  76        (require 'hui-menu)
  77        ;; XEmacs or Emacs19 under a window system; add Hyperbole menu to
  78        ;; menubar.
  79        (hyperbole-menubar-menu)))
  80
  81 (defcustom hyperbole-on-menubar t
  82   "Whether the hyperbole menu should be on the menubar."
  83   :group 'hyperbole
  84   :type 'boolean
  85   :set (lambda (symb val)
  86          (set symb val)
  87          (if (null val)
  88              (hui-menu-remove)
  89            (hyperb:init-menubar)))
  90   :require 'hui-menu)
  91
  92 (defun hyperb:act-set ()
  93   "COORDINATION IS NOT YET OPERATIONAL.  hui-coord.el IS NOT INCLUDED.
  94 Sets Hyperbole action command to uncoordinated or coordinated operation.
  95 Coordinated is used when 'hcoord:hosts' is a non-nil list.
  96 See \"hui-coord.el\"."
  97   (interactive)
  98   (fset 'hyperb:act (if (and (boundp 'hcoord:hosts) hcoord:hosts)
  99                      'hcoord:act 'hbut:act)))
 100
 101
 102 ;;;
 103 ;;; Private functions
 104 ;;;
 105
 106 (defun hyperb:check-dir-user ()
 107   "Ensures 'hbmap:dir-user' exists and is writable or signals an error."
 108   (if (or (null hbmap:dir-user) (not (stringp hbmap:dir-user))
 109           (and (setq hbmap:dir-user (file-name-as-directory
 110                                      (expand-file-name hbmap:dir-user)))
 111                (file-directory-p hbmap:dir-user)
 112                (not (file-writable-p (directory-file-name hbmap:dir-user)))))
 113       (error
 114        "(hyperb:init): 'hbmap:dir-user' must be a writable directory name."))
 115   (let ((hbmap:dir-user (directory-file-name hbmap:dir-user)))
 116     (or (file-directory-p hbmap:dir-user)   ;; Exists and is writable.
 117         (let* ((parent-dir (file-name-directory
 118                             (directory-file-name hbmap:dir-user))))
 119           (cond
 120            ((not (file-directory-p parent-dir))
 121             (error
 122              "(hyperb:init): 'hbmap:dir-user' parent dir does not exist."))
 123            ((not (file-writable-p parent-dir))
 124             (error
 125              "(hyperb:init): 'hbmap:dir-user' parent directory not writable."))
 126            ((or (if (fboundp 'make-directory)
 127                     (progn (make-directory hbmap:dir-user) t))
 128                 (hypb:call-process-p "mkdir" nil nil hbmap:dir-user))
 129             (or (file-writable-p hbmap:dir-user)
 130                 (or (progn (hypb:chmod '+ 700 hbmap:dir-user)
 131                            (file-writable-p hbmap:dir-user))
 132                     (error "(hyperb:init): Can't write to 'hbmap:dir-user'.")
 133                     )))
 134            (t (error "(hyperb:init): 'hbmap:dir-user' create failed."))))))
 135   t)
 136
 137 (provide 'hinit)
 138
 139 ;;; hinit.el ends here