155
|
1 ;;; install.el --- Emacs Lisp package install utility
|
|
2
|
|
3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
6 ;; Created: 1996/8/18
|
|
7 ;; Version: $Id: install.el,v 1.1 1997/06/03 04:18:35 steve Exp $
|
|
8 ;; Keywords: install
|
|
9
|
|
10 ;; This file is part of tl (Tiny Library).
|
|
11
|
|
12 ;; This program 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 2, or (at
|
|
15 ;; your option) any later version.
|
|
16
|
|
17 ;; This program is distributed in the hope that it will be useful, but
|
|
18 ;; 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
|
|
24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
26
|
|
27 ;;; Code:
|
|
28
|
|
29 (require 'emu)
|
|
30 (require 'file-detect)
|
|
31
|
|
32 ;;; @ compile Emacs Lisp files
|
|
33 ;;;
|
|
34
|
|
35 (defun compile-elisp-module (module &optional path every-time)
|
|
36 (setq module (expand-file-name (symbol-name module) path))
|
|
37 (let ((el-file (concat module ".el"))
|
|
38 (elc-file (concat module ".elc"))
|
|
39 )
|
|
40 (if (or every-time
|
|
41 (file-newer-than-file-p el-file elc-file))
|
|
42 (byte-compile-file el-file)
|
|
43 )
|
|
44 ))
|
|
45
|
|
46 (defun compile-elisp-modules (modules &optional path every-time)
|
|
47 (mapcar (function
|
|
48 (lambda (module)
|
|
49 (compile-elisp-module module path every-time)
|
|
50 ))
|
|
51 modules))
|
|
52
|
|
53
|
|
54 ;;; @ install files
|
|
55 ;;;
|
|
56
|
|
57 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
|
|
58
|
|
59 (defun install-file (file src dest &optional move overwrite)
|
|
60 (let ((src-file (expand-file-name file src)))
|
|
61 (if (file-exists-p src-file)
|
|
62 (let ((full-path (expand-file-name file dest)))
|
|
63 (if (and (file-exists-p full-path) overwrite)
|
|
64 (delete-file full-path)
|
|
65 )
|
|
66 (copy-file src-file full-path t t)
|
|
67 (if move
|
|
68 (catch 'tag
|
|
69 (while (and (file-exists-p src-file)
|
|
70 (file-writable-p src-file))
|
|
71 (condition-case err
|
|
72 (progn
|
|
73 (delete-file src-file)
|
|
74 (throw 'tag nil)
|
|
75 )
|
|
76 (error (princ (format "%s\n" (nth 1 err))))
|
|
77 ))))
|
|
78 (princ (format "%s -> %s\n" file dest))
|
|
79 ))
|
|
80 ))
|
|
81
|
|
82 (defun install-files (files src dest &optional move overwrite)
|
|
83 (or (file-exists-p dest)
|
|
84 (make-directory dest t)
|
|
85 )
|
|
86 (mapcar (function (lambda (file)
|
|
87 (install-file file src dest move overwrite)
|
|
88 ))
|
|
89 files))
|
|
90
|
|
91
|
|
92 ;;; @@ install Emacs Lisp files
|
|
93 ;;;
|
|
94
|
|
95 (defun install-elisp-module (module src dest)
|
|
96 (let (el-file elc-file)
|
|
97 (let ((name (symbol-name module)))
|
|
98 (setq el-file (concat name ".el"))
|
|
99 (setq elc-file (concat name ".elc"))
|
|
100 )
|
|
101 (let ((src-file (expand-file-name el-file src)))
|
|
102 (if (file-exists-p src-file)
|
|
103 (let ((full-path (expand-file-name el-file dest)))
|
|
104 (if (file-exists-p full-path)
|
|
105 (delete-file full-path)
|
|
106 )
|
|
107 (copy-file src-file full-path t t)
|
|
108 (princ (format "%s -> %s\n" el-file dest))
|
|
109 ))
|
|
110 (setq src-file (expand-file-name elc-file src))
|
|
111 (if (file-exists-p src-file)
|
|
112 (let ((full-path (expand-file-name elc-file dest)))
|
|
113 (if (file-exists-p full-path)
|
|
114 (delete-file full-path)
|
|
115 )
|
|
116 (copy-file src-file full-path t t)
|
|
117 (catch 'tag
|
|
118 (while (file-exists-p src-file)
|
|
119 (condition-case err
|
|
120 (progn
|
|
121 (delete-file src-file)
|
|
122 (throw 'tag nil)
|
|
123 )
|
|
124 (error (princ (format "%s\n" (nth 1 err))))
|
|
125 )))
|
|
126 (princ (format "%s -> %s\n" elc-file dest))
|
|
127 ))
|
|
128 )))
|
|
129
|
|
130 (defun install-elisp-modules (modules src dest)
|
|
131 (or (file-exists-p dest)
|
|
132 (make-directory dest t)
|
|
133 )
|
|
134 (mapcar (function (lambda (module)
|
|
135 (install-elisp-module module src dest)
|
|
136 ))
|
|
137 modules))
|
|
138
|
|
139
|
|
140 ;;; @ detect install path
|
|
141 ;;;
|
|
142
|
|
143 (defvar install-prefix
|
|
144 (if (or running-emacs-18 running-xemacs)
|
|
145 (expand-file-name "../../.." exec-directory)
|
|
146 (expand-file-name "../../../.." data-directory)
|
|
147 )) ; install to shared directory (maybe "/usr/local")
|
|
148
|
|
149 (defvar install-elisp-prefix
|
|
150 (if (>= emacs-major-version 19)
|
|
151 "site-lisp"
|
|
152 "local.lisp"))
|
|
153
|
|
154 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
|
|
155 allow-version-specific)
|
|
156 (or prefix
|
|
157 (setq prefix install-prefix)
|
|
158 )
|
|
159 (or elisp-prefix
|
|
160 (setq elisp-prefix install-elisp-prefix)
|
|
161 )
|
|
162 (or
|
|
163 (catch 'tag
|
|
164 (let ((rest default-load-path)
|
|
165 dir)
|
|
166 (while (setq dir (car rest))
|
|
167 (if (string-match
|
|
168 (concat "^"
|
|
169 (expand-file-name (concat ".*/" elisp-prefix) prefix)
|
|
170 "$")
|
|
171 dir)
|
|
172 (if (or allow-version-specific
|
|
173 (not (string-match (format "%d\\.%d"
|
|
174 emacs-major-version
|
|
175 emacs-minor-version) dir))
|
|
176 )
|
|
177 (throw 'tag dir)
|
|
178 ))
|
|
179 (setq rest (cdr rest))
|
|
180 )))
|
|
181 (expand-file-name (concat
|
|
182 (if running-emacs-19_29-or-later
|
|
183 "share/"
|
|
184 "lib/")
|
|
185 (cond ((boundp 'NEMACS) "nemacs/")
|
|
186 ((boundp 'MULE) "mule/")
|
|
187 (running-xemacs
|
|
188 (if (featurep 'mule)
|
|
189 "xmule/"
|
|
190 "xemacs/"))
|
|
191 (t "emacs/"))
|
|
192 elisp-prefix) prefix)
|
|
193 ))
|
|
194
|
|
195 (defvar install-default-elisp-directory
|
|
196 (install-detect-elisp-directory))
|
|
197
|
|
198
|
|
199 ;;; @ end
|
|
200 ;;;
|
|
201
|
|
202 (provide 'install)
|
|
203
|
|
204 ;;; install.el ends here
|