hyperbole / hinit.el

Full commit
;; FILE:         hinit.el
;; SUMMARY:      Standard initializations for Hyperbole hypertext system.
;; USAGE:        GNU Emacs Lisp Library
;; KEYWORDS:     hypermedia
;; AUTHOR:       Bob Weiner
;; ORG:
;; ORIG-DATE:     1-Oct-91 at 02:32:51
;; LAST-MOD:     13-Jun-99 at 01:13:09 by Bob Weiner
;; Copyright (C) 1991-1997, and the Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;; This file is part of Hyperbole.

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

(defvar   hyperb:host-domain nil
  "<@domain-name> for current host.  Set automatically by `hyperb:init'.")

;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************

(require 'hvar)

(mapcar 'require '(hui-mouse hypb hui hui-mini hbmap hibtypes))

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

(if (not (fboundp 'br-in-browser))
    ;; Then the OO-Browser is not loaded, so we can never be within the
    ;; browser.  Define this as a dummy function that always returns nil
    ;; until the OO-Browser is ever loaded.
    (defun br-in-browser ()
      "Always returns nil since the OO-Browser is not loaded."

(defun hyperb:init ()
  "Standard configuration routine for Hyperbole."
  (run-hooks 'hyperb:init-hook)
  (or hyperb:host-domain (setq hyperb:host-domain (hypb:domain-name)))
  ;; Save button attribute file whenever same dir file is saved and
  ;; `ebut:hattr-save' is non-nil.
  (var:append 'write-file-hooks '(hattr:save))
  (if hyperbole-on-menubar (hyperb:init-menubar)))

(defun hyperb:init-menubar ()
  "Add a pulldown menu for Hyperbole, if appropriate."
  (and hyperb:window-system
       (or hyperb:xemacs-p
	   (if hyperb:emacs19-p
	       (require 'lmenu)))
       (require 'hui-menu)
       ;; XEmacs or Emacs19 under a window system; add Hyperbole menu to
       ;; menubar.

(defcustom hyperbole-on-menubar t
  "Whether the hyperbole menu should be on the menubar."
  :group 'hyperbole
  :type 'boolean
  :set (lambda (symb val) 
	 (set symb val)
	 (if (null val)
  :require 'hui-menu)

(defun hyperb:act-set ()
Sets Hyperbole action command to uncoordinated or coordinated operation.
Coordinated is used when `hcoord:hosts' is a non-nil list.
See \"hui-coord.el\"."
  (defalias 'hyperb:act (if (and (boundp 'hcoord:hosts) hcoord:hosts)
		     'hcoord:act 'hbut:act)))

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

(defun hyperb:check-dir-user ()
  "Ensures `hbmap:dir-user' exists and is writable or signals an error."
  (if (or (null hbmap:dir-user) (not (stringp hbmap:dir-user))
	  (and (setq hbmap:dir-user (file-name-as-directory
				     (expand-file-name hbmap:dir-user)))
	       (file-directory-p hbmap:dir-user)
	       (not (file-writable-p (directory-file-name hbmap:dir-user)))))
       "(hyperb:init): `hbmap:dir-user' must be a writable directory name."))
  (let ((hbmap:dir-user (directory-file-name hbmap:dir-user)))
    (or (file-directory-p hbmap:dir-user)   ;; Exists and is writable.
	(let* ((parent-dir (file-name-directory
			    (directory-file-name hbmap:dir-user))))
	   ((not (file-directory-p parent-dir))
	     "(hyperb:init): `hbmap:dir-user' parent dir does not exist."))
	   ((not (file-writable-p parent-dir))
	     "(hyperb:init): `hbmap:dir-user' parent directory not writable."))
	   ((or (if (fboundp 'make-directory)
		    (progn (make-directory hbmap:dir-user) t))
		(hypb:call-process-p "mkdir" nil nil hbmap:dir-user))
	    (or (file-writable-p hbmap:dir-user)
		(or (progn (hypb:chmod '+ 700 hbmap:dir-user)
			   (file-writable-p hbmap:dir-user))
		    (error "(hyperb:init): Can't write to 'hbmap:dir-user'.")
	   (t (error "(hyperb:init): `hbmap:dir-user' create failed."))))))

(provide 'hinit)