Mercurial > hg > xemacs-beta
comparison lisp/hyperbole/hinit.el @ 24:4103f0995bd7 r19-15b95
Import from CVS: tag r19-15b95
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:51:03 +0200 |
parents | 376386a54a3c |
children | 131b0175ea99 |
comparison
equal
deleted
inserted
replaced
23:0edd3412f124 | 24:4103f0995bd7 |
---|---|
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: Brown U. | 9 ;; ORG: InfoDock Associates |
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: 22-Oct-95 at 00:27:13 by Bob Weiner | 12 ;; LAST-MOD: 17-Feb-97 at 16:03:46 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-1995, Free Software Foundation, Inc. | 17 ;; Copyright (C) 1991-1997, 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 |