Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 215:1f0dabaa0855 r20-4b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b6
author cvs
date Mon, 13 Aug 2007 10:07:35 +0200
parents 78f53ef88e17
children d44af0c54775
comparison
equal deleted inserted replaced
214:c5d88c05e1e9 215:1f0dabaa0855
135 This function is used during build to find where the global symbol files so 135 This function is used during build to find where the global symbol files so
136 they can be perused for their useful information." 136 they can be perused for their useful information."
137 ;; Source directory may not be initialized yet. 137 ;; Source directory may not be initialized yet.
138 ;; (print (prin1-to-string load-path)) 138 ;; (print (prin1-to-string load-path))
139 (if (null source-directory) 139 (if (null source-directory)
140 (setq source-directory (concat (car load-path) "/./"))) 140 (setq source-directory (concat (car load-path) "./")))
141 (let ((files (directory-files (file-name-as-directory source-directory) t ".*")) 141 (let ((files (directory-files (file-name-as-directory source-directory) t ".*"))
142 file autolist) 142 file autolist)
143 ;; (print (prin1-to-string source-directory))
144 ;; (print (prin1-to-string files))
143 (while (setq file (car-safe files)) 145 (while (setq file (car-safe files))
144 (if (and (file-directory-p file) 146 (if (and (file-directory-p file)
145 (file-exists-p (concat file "/" autoload-file-name))) 147 (file-exists-p (concat file "/" autoload-file-name)))
146 (setq autolist (cons (concat file "/" autoload-file-name) 148 (setq autolist (cons (concat file "/" autoload-file-name)
147 autolist))) 149 autolist)))
148 (setq files (cdr files))) 150 (setq files (cdr files)))
149 autolist)) 151 autolist))
150 152
151 ;; The following function is called from temacs 153 ;; The following function is called from temacs
152 (defun packages-find-packages-1 (package path-only user-package) 154 (defun packages-find-packages-1 (package path-only append-p user-package)
153 "Search the supplied directory for associated directories. 155 "Search the supplied directory for associated directories.
154 The top level is assumed to look like: 156 The top level is assumed to look like:
155 info/ Contain texinfo files for lisp installed in this hierarchy 157 info/ Contain texinfo files for lisp installed in this hierarchy
156 etc/ Contain data files for lisp installled in this hiearchy 158 etc/ Contain data files for lisp installled in this hiearchy
157 lisp/ Contain directories which either have straight lisp code 159 lisp/ Contain directories which either have straight lisp code
158 or are self-contained packages of their own. 160 or are self-contained packages of their own.
161
162 If the argument `append-p' is non-nil, the found directories will be
163 appended to the paths, otherwise, they will be prepended.
159 164
160 This is an internal function. Do not call it after startup." 165 This is an internal function. Do not call it after startup."
161 ;; Info files 166 ;; Info files
162 (if (and (null path-only) (file-directory-p (concat package "/info"))) 167 (if (and (null path-only) (file-directory-p (concat package "/info")))
163 (let ((dir (concat package "/info/"))) 168 (let ((dir (concat package "/info/")))
164 (if (not (member dir Info-default-directory-list)) 169 (if (not (member dir Info-default-directory-list))
165 (nconc Info-default-directory-list (list dir))))) 170 (nconc Info-default-directory-list (list dir)))))
166 ;; Data files 171 ;; Data files
167 (if (and (null path-only) (file-directory-p (concat package "/etc"))) 172 (if (and (null path-only) (file-directory-p (concat package "/etc")))
168 (setq data-directory-list 173 (setq data-directory-list
169 (cons (concat package "/etc/") data-directory-list))) 174 (if append-p
175 (append data-directory-list (list (concat package "/etc/")))
176 (cons (concat package "/etc/") data-directory-list))))
170 ;; Lisp files 177 ;; Lisp files
171 (if (file-directory-p (concat package "/lisp")) 178 (if (file-directory-p (concat package "/lisp"))
172 (progn 179 (progn
173 ; (print (concat "DIR: " 180 ; (print (concat "DIR: "
174 ; (if user-package "[USER]" "") 181 ; (if user-package "[USER]" "")
175 ; package 182 ; package
176 ; "/lisp/")) 183 ; "/lisp/"))
177 (setq load-path (cons (concat package "/lisp/") load-path)) 184 (setq load-path
185 (if append-p
186 (append load-path (list (concat package "/lisp/")))
187 (cons (concat package "/lisp/") load-path)))
178 (if user-package 188 (if user-package
179 (condition-case nil 189 (condition-case nil
180 (load (concat package "/lisp/" 190 (load (concat package "/lisp/"
181 (file-name-sans-extension autoload-file-name))) 191 (file-name-sans-extension autoload-file-name)))
182 (t nil))) 192 (t nil)))
184 t "^[^-.]" nil 'dirs-only)) 194 t "^[^-.]" nil 'dirs-only))
185 dir) 195 dir)
186 (while dirs 196 (while dirs
187 (setq dir (car dirs)) 197 (setq dir (car dirs))
188 ; (print (concat "DIR: " dir "/")) 198 ; (print (concat "DIR: " dir "/"))
189 (setq load-path (cons (concat dir "/") load-path)) 199 (setq load-path
200 (if append-p
201 (append load-path (list (concat dir "/")))
202 (cons (concat dir "/") load-path)))
190 (if user-package 203 (if user-package
191 (condition-case nil 204 (condition-case nil
192 (progn 205 (progn
193 ; (print 206 ; (print
194 ; (concat dir "/" 207 ; (concat dir "/"
195 ; (file-name-sans-extension autoload-file-name))) 208 ; (file-name-sans-extension autoload-file-name)))
196 (load 209 (load
197 (concat dir "/" 210 (concat dir "/"
198 (file-name-sans-extension autoload-file-name)))) 211 (file-name-sans-extension autoload-file-name))))
199 (t nil))) 212 (t nil)))
200 (packages-find-packages-1 dir path-only user-package) 213 (packages-find-packages-1 dir path-only append-p user-package)
201 (setq dirs (cdr dirs))))))) 214 (setq dirs (cdr dirs)))))))
215
216 ;; The following function is called from temacs
217 (defun packages-find-packages-2 (path path-only append-p suppress-user)
218 "Search the supplied path for associated directories.
219 If the argument `append-p' is non-nil, the found directories will be
220 appended to the paths, otherwise, they will be prepended.
221
222 This is an internal function. Do not call it after startup."
223 (let (dir)
224 (while path
225 (setq dir (car path))
226 ;; (prin1 (concat "Find: " (expand-file-name dir) "\n"))
227 (if (null (and (or suppress-user inhibit-package-init)
228 (string-match "^~" dir)))
229 (progn
230 ;; (print dir)
231 (packages-find-packages-1 (expand-file-name dir)
232 path-only
233 append-p
234 (string-match "^~" dir))))
235 (setq path (cdr path)))))
202 236
203 ;; The following function is called from temacs 237 ;; The following function is called from temacs
204 (defun packages-find-packages (pkg-path path-only &optional suppress-user) 238 (defun packages-find-packages (pkg-path path-only &optional suppress-user)
205 "Search the supplied path for additional info/etc/lisp directories. 239 "Search the supplied path for additional info/etc/lisp directories.
206 Lisp directories if configured prior to build time will have equivalent 240 Lisp directories if configured prior to build time will have equivalent
208 If the argument `path-only' is non-nil, only the `load-path' will be set, 242 If the argument `path-only' is non-nil, only the `load-path' will be set,
209 otherwise data directories and info directories will be added. 243 otherwise data directories and info directories will be added.
210 If the optional argument `suppress-user' is non-nil, package directories 244 If the optional argument `suppress-user' is non-nil, package directories
211 rooted in a user login directory (like ~/.xemacs) will not be searched. 245 rooted in a user login directory (like ~/.xemacs) will not be searched.
212 This is used at dump time to suppress the builder's local environment." 246 This is used at dump time to suppress the builder's local environment."
213 (let ((path (reverse pkg-path)) 247 (let ((prefix-path nil))
214 dir) 248 (while (and pkg-path (car pkg-path))
215 (while path 249 (setq prefix-path (cons (car pkg-path) prefix-path)
216 (setq dir (car path)) 250 pkg-path (cdr pkg-path)))
217 ;; (prin1 (concat "Find: " (expand-file-name dir) "\n")) 251 (packages-find-packages-2 (cdr pkg-path) path-only t suppress-user)
218 (if (null (and (or suppress-user inhibit-package-init) 252 (packages-find-packages-2 prefix-path path-only nil suppress-user)))
219 (string-match "^~" dir))) 253
220 (progn
221 ;; (print dir)
222 (packages-find-packages-1 (expand-file-name dir)
223 path-only
224 (string-match "^~" dir))))
225 (setq path (cdr path)))))
226 254
227 ;; Data-directory is really a list now. Provide something to search it for 255 ;; Data-directory is really a list now. Provide something to search it for
228 ;; directories. 256 ;; directories.
229 257
230 (defun locate-data-directory (name &optional dir-list) 258 (defun locate-data-directory (name &optional dir-list)
239 (or found-dir 267 (or found-dir
240 (setq found nil)) 268 (setq found nil))
241 (setq dir-list (cdr dir-list))) 269 (setq dir-list (cdr dir-list)))
242 found)) 270 found))
243 271
272 ;; Data-directory is really a list now. Provide something to search it for
273 ;; files.
274
275 (defun locate-data-file (name &optional dir-list)
276 "Locate a file in a search path DIR-LIST (a list of directories).
277 If no DIR-LIST is supplied, it defaults to `data-directory-list'."
278 (unless dir-list
279 (setq dir-list data-directory-list))
280 (let (found found-file)
281 (while (and (null found-file) dir-list)
282 (setq found (concat (car dir-list) name)
283 found-file (and (file-exists-p found)
284 (not (file-directory-p found))))
285 (or found-file
286 (setq found nil))
287 (setq dir-list (cdr dir-list)))
288 found))
289
244 ;; If we are being loaded as part of being dumped, bootstrap the rest of the 290 ;; If we are being loaded as part of being dumped, bootstrap the rest of the
245 ;; load-path for loaddefs. 291 ;; load-path for loaddefs.
246 (if (fboundp 'load-gc) 292 (if (fboundp 'load-gc)
247 (packages-find-packages package-path t t)) 293 (packages-find-packages package-path t t))
248 294