1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
#| rep.system bootstrap
$Id: system.jl,v 1.4 2000/09/08 14:53:46 john Exp $
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
This file is part of librep.
librep is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
librep is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with librep; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|#
(declare (in-module rep.system))
(open-structures '(rep.lang.symbols
rep.data
rep.io.files))
;;; Hook manipulation
(defun add-hook (hook-symbol new-func #!optional at-end)
"Arrange it so that FUNCTION-NAME is added to the hook-list stored in
symbol, HOOK-SYMBOL. It will added at the head of the list unless AT-END
is true in which case it is added at the end."
(unless (boundp hook-symbol)
(make-variable-special hook-symbol)
(set hook-symbol nil))
(if at-end
(set hook-symbol (nconc (symbol-value hook-symbol) (cons new-func nil)))
(set hook-symbol (cons new-func (symbol-value hook-symbol)))))
(defun remove-hook (hook-symbol old-func)
"Remove FUNCTION-NAME from the hook HOOK-SYMBOL."
(set hook-symbol (delete old-func (symbol-value hook-symbol))))
(defun in-hook-p (hook-symbol fun)
"Returns t if the function FUN is stored in the hook called HOOK-SYMBOL."
(and (boundp hook-symbol) (memq fun (symbol-value hook-symbol))))
(export-bindings '(add-hook remove-hook in-hook-p))
;;; misc
(autoload 'getenv "rep/system/environ")
(autoload 'setenv "rep/system/environ")
(autoload 'unsetenv "rep/system/environ")
(autoload 'pwd-prompt "rep/system/pwd-prompt")
(export-bindings '(getenv setenv unsetenv
operating-system rep-version rep-interface-id
rep-build-id pwd-prompt))
|
