Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hinit.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
4 ;; SUMMARY: Standard initializations for Hyperbole hypertext system. 4 ;; SUMMARY: Standard initializations for Hyperbole hypertext system.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia 6 ;; KEYWORDS: hypermedia
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: InfoDock Associates 9 ;; ORG: Brown U.
10 ;; 10 ;;
11 ;; ORIG-DATE: 1-Oct-91 at 02:32:51 11 ;; ORIG-DATE: 1-Oct-91 at 02:32:51
12 ;; LAST-MOD: 17-Feb-97 at 16:03:46 by Bob Weiner 12 ;; LAST-MOD: 22-Oct-95 at 00:27:13 by Bob Weiner
13 ;; 13 ;;
14 ;; This file is part of Hyperbole. 14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 16 ;;
17 ;; Copyright (C) 1991-1997, Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc. 18 ;; Developed with support from Motorola Inc.
19 ;; 19 ;;
20 ;; DESCRIPTION: 20 ;; DESCRIPTION:
21 ;; DESCRIP-END. 21 ;; DESCRIP-END.
22 22
23 ;;; ************************************************************************ 23 ;;; ************************************************************************
24 ;;; Public variables 24 ;;; Public variables
25 ;;; ************************************************************************ 25 ;;; ************************************************************************
26 26
27 (defvar hyperb:host-domain nil 27 (defvar hyperb:host-domain nil
28 "<@domain-name> for current host. Set automatically by `hyperb:init'.") 28 "<@domain-name> for current host. Set automatically by 'hyperb:init'.")
29 29
30 ;;; ************************************************************************ 30 ;;; ************************************************************************
31 ;;; Other required Elisp libraries 31 ;;; Other required Elisp libraries
32 ;;; ************************************************************************ 32 ;;; ************************************************************************
33 33
54 (hyperb:check-dir-user) 54 (hyperb:check-dir-user)
55 (or hyperb:host-domain (setq hyperb:host-domain (hypb:domain-name))) 55 (or hyperb:host-domain (setq hyperb:host-domain (hypb:domain-name)))
56 (hyperb:act-set) 56 (hyperb:act-set)
57 ;; 57 ;;
58 ;; Save button attribute file whenever same dir file is saved and 58 ;; Save button attribute file whenever same dir file is saved and
59 ;; `ebut:hattr-save' is non-nil. 59 ;; 'ebut:hattr-save' is non-nil.
60 ;; 60 ;;
61 (var:append 'write-file-hooks '(hattr:save)) 61 (var:append 'write-file-hooks '(hattr:save))
62 ;; 62 ;;
63 (hyperb:init-menubar)) 63 (hyperb:init-menubar))
64 64
74 (hyperbole-menubar-menu))) 74 (hyperbole-menubar-menu)))
75 75
76 (defun hyperb:act-set () 76 (defun hyperb:act-set ()
77 "COORDINATION IS NOT YET OPERATIONAL. hui-coord.el IS NOT INCLUDED. 77 "COORDINATION IS NOT YET OPERATIONAL. hui-coord.el IS NOT INCLUDED.
78 Sets Hyperbole action command to uncoordinated or coordinated operation. 78 Sets Hyperbole action command to uncoordinated or coordinated operation.
79 Coordinated is used when `hcoord:hosts' is a non-nil list. 79 Coordinated is used when 'hcoord:hosts' is a non-nil list.
80 See \"hui-coord.el\"." 80 See \"hui-coord.el\"."
81 (interactive) 81 (interactive)
82 (fset 'hyperb:act (if (and (boundp 'hcoord:hosts) hcoord:hosts) 82 (fset 'hyperb:act (if (and (boundp 'hcoord:hosts) hcoord:hosts)
83 'hcoord:act 'hbut:act))) 83 'hcoord:act 'hbut:act)))
84 84
86 ;;; ************************************************************************ 86 ;;; ************************************************************************
87 ;;; Private functions 87 ;;; Private functions
88 ;;; ************************************************************************ 88 ;;; ************************************************************************
89 89
90 (defun hyperb:check-dir-user () 90 (defun hyperb:check-dir-user ()
91 "Ensures `hbmap:dir-user' exists and is writable or signals an error." 91 "Ensures 'hbmap:dir-user' exists and is writable or signals an error."
92 (if (or (null hbmap:dir-user) (not (stringp hbmap:dir-user)) 92 (if (or (null hbmap:dir-user) (not (stringp hbmap:dir-user))
93 (and (setq hbmap:dir-user (file-name-as-directory 93 (and (setq hbmap:dir-user (file-name-as-directory
94 (expand-file-name hbmap:dir-user))) 94 (expand-file-name hbmap:dir-user)))
95 (file-directory-p hbmap:dir-user) 95 (file-directory-p hbmap:dir-user)
96 (not (file-writable-p (directory-file-name hbmap:dir-user))))) 96 (not (file-writable-p (directory-file-name hbmap:dir-user)))))
97 (error 97 (error
98 "(hyperb:init): `hbmap:dir-user' must be a writable directory name.")) 98 "(hyperb:init): 'hbmap:dir-user' must be a writable directory name."))
99 (let ((hbmap:dir-user (directory-file-name hbmap:dir-user))) 99 (let ((hbmap:dir-user (directory-file-name hbmap:dir-user)))
100 (or (file-directory-p hbmap:dir-user) ;; Exists and is writable. 100 (or (file-directory-p hbmap:dir-user) ;; Exists and is writable.
101 (let* ((parent-dir (file-name-directory 101 (let* ((parent-dir (file-name-directory
102 (directory-file-name hbmap:dir-user)))) 102 (directory-file-name hbmap:dir-user))))
103 (cond 103 (cond
104 ((not (file-directory-p parent-dir)) 104 ((not (file-directory-p parent-dir))
105 (error 105 (error
106 "(hyperb:init): `hbmap:dir-user' parent dir does not exist.")) 106 "(hyperb:init): 'hbmap:dir-user' parent dir does not exist."))
107 ((not (file-writable-p parent-dir)) 107 ((not (file-writable-p parent-dir))
108 (error 108 (error
109 "(hyperb:init): `hbmap:dir-user' parent directory not writable.")) 109 "(hyperb:init): 'hbmap:dir-user' parent directory not writable."))
110 ((or (if (fboundp 'make-directory) 110 ((or (if (fboundp 'make-directory)
111 (progn (make-directory hbmap:dir-user) t)) 111 (progn (make-directory hbmap:dir-user) t))
112 (hypb:call-process-p "mkdir" nil nil hbmap:dir-user)) 112 (hypb:call-process-p "mkdir" nil nil hbmap:dir-user))
113 (or (file-writable-p hbmap:dir-user) 113 (or (file-writable-p hbmap:dir-user)
114 (or (progn (hypb:chmod '+ 700 hbmap:dir-user) 114 (or (progn (hypb:chmod '+ 700 hbmap:dir-user)
115 (file-writable-p hbmap:dir-user)) 115 (file-writable-p hbmap:dir-user))
116 (error "(hyperb:init): Can't write to 'hbmap:dir-user'.") 116 (error "(hyperb:init): Can't write to 'hbmap:dir-user'.")
117 ))) 117 )))
118 (t (error "(hyperb:init): `hbmap:dir-user' create failed.")))))) 118 (t (error "(hyperb:init): 'hbmap:dir-user' create failed."))))))
119 t) 119 t)
120 120
121 (provide 'hinit) 121 (provide 'hinit)
122 122